From hahn Require Import Hahn.

Require Import Events.
Require Import Execution.

Set Implicit Arguments.
Remove Hints plus_n_O.

Section CO.

Variables G : execution.
Variable I : actid -> Prop.  (* issued *)
Variable T : actid -> Prop.  (* all writes in certified thread *)

Notation "'E'" := G.(acts_set).
Notation "'acts'" := G.(acts).
Notation "'lab'" := G.(lab).
Notation "'sb'" := G.(sb).
Notation "'rf'" := G.(rf).
Notation "'co'" := G.(co).
Notation "'W'" := (fun a => is_true (is_w lab a)).
Notation "'loc'" := (loc lab).
Notation "'same_loc'" := (same_loc lab).
Notation "'Loc_' l" := (fun x => loc x = Some l) (at level 1).
Notation "'W_' l" := (W ∩₁ Loc_ l) (at level 1).

Hypothesis IT: I ∪₁ T ≡₁ E ∩₁ W.

Lemma IN_I: I ⊆₁ E ∩₁ W.
Proof using IT.
rewrite <- IT; basic_solver 21.
Qed.

Lemma IN_T: T ⊆₁ E ∩₁ W.
Proof using IT.
rewrite <- IT; basic_solver 21.
Qed.

Hypothesis wf_coE : co ≡ ⦗E⦘ ⨾ co ⨾ ⦗E⦘.
Hypothesis wf_coD : co ≡ ⦗W⦘ ⨾ co ⨾ ⦗W⦘.
Hypothesis wf_col : co ⊆ same_loc.
Hypothesis co_trans : transitive co.
Hypothesis wf_co_total : forall ol, is_total (E ∩₁ W ∩₁ (fun x => loc x = ol)) co.
Hypothesis co_irr : irreflexive co.

Definition col l := (⦗Loc_ l⦘ ⨾ co ⨾ ⦗Loc_ l⦘).

Definition col0 l := (⦗I⦘ ⨾ col l ⨾ ⦗I⦘ ∪ ⦗T⦘ ⨾ col l ⨾ ⦗T⦘ ∪ ⦗I⦘ ⨾ col l ⨾ ⦗T⦘)⁺.

Definition new_col l := pref_union (col0 l) ((I ∩₁ Loc_ l) × (E ∩₁ W ∩₁ Loc_ l \₁ I)).

Definition new_co x y := exists l, (new_col l) x y.

Lemma col_in_co l : col l ⊆ co.
Proof using.
unfold col; basic_solver.
Qed.

Lemma co_in_col x y : co x y -> exists l, col l x y.
Proof using wf_coD wf_col.
unfold new_co, col; ins; unfolder; ins; desf.
hahn_rewrite (dom_l wf_coD) in H; unfolder in H; desc.
generalize (is_w_loc lab x H); ins; desf.
eexists; splits; eauto.
eexists; splits; eauto.
eexists; splits; eauto.
apply wf_col in H0; unfold Events.same_loc in H0; congruence.
Qed.

Lemma wf_colE l : col l ≡ ⦗E⦘ ⨾ col l ⨾ ⦗E⦘.
Proof using wf_coE.
apply dom_helper_3; unfold col; rewrite wf_coE; basic_solver.
Qed.

Lemma wf_colD l : col l ≡ ⦗W_ l⦘ ⨾ col l ⨾ ⦗W_ l⦘.
Proof using wf_coD.
apply dom_helper_3; unfold col; rewrite wf_coD; basic_solver.
Qed.

Lemma wf_coll l : col l ⊆ same_loc.
Proof using wf_col.
unfold col; rewrite wf_col; basic_solver.
Qed.

Lemma col_trans l : transitive (col l).
Proof using co_trans.
unfold col.
rewrite <- restr_relE.
by apply transitive_restr.
Qed.

Lemma wf_col_total l : is_total (E ∩₁ W ∩₁ Loc_ l) (col l).
Proof using wf_coD wf_coE wf_co_total.
rewrite wf_colD, wf_colE.
unfold col; rewrite !seqA.
arewrite (⦗W_ l⦘ ⨾ ⦗E⦘ ⨾ ⦗Loc_ l⦘ ≡ ⦗E ∩₁ W ∩₁ Loc_ l⦘) by basic_solver.
arewrite (⦗Loc_ l⦘ ⨾ ⦗E⦘ ⨾ ⦗W_ l⦘ ≡ ⦗E ∩₁ W ∩₁ Loc_ l⦘) by basic_solver.
rewrite <- restr_relE.
apply is_total_restr.
apply wf_co_total.
Qed.

Lemma col_irr l: irreflexive (col l).
Proof using co_irr.
unfold col.
rewrite <- restr_relE.
by apply irreflexive_restr.
Qed.

Lemma acyclic_new_col l : acyclic (new_col l).
Proof using IT co_irr co_trans wf_coD wf_coE wf_co_total.
eapply acyclic_pref_union with (dom:=I ∩₁ Loc_ l).
- unfold col0.
  arewrite_id ⦗I⦘.
  arewrite_id ⦗T⦘.
  relsf.
  generalize (@col_trans l); ins; relsf; apply col_irr.
- unfold col0; relsf.
- assert (XX: restr_rel (I ∩₁ Loc_ l) (col l) ⊆ col0 l).
  by unfold col0; rewrite <- ct_step; basic_solver 21.
  rewrite <- XX.
  apply is_total_restr.
  rewrite IN_I.
  eapply wf_col_total.
- unfolder; ins; desf; splits; eauto; intro; desf.
Qed.

Lemma wf_new_colE l : new_col l ≡ ⦗E⦘ ⨾ new_col l ⨾ ⦗E⦘.
Proof using IT wf_coE.
apply dom_helper_3.
unfold new_col, pref_union, col0; unfolder; ins; desf.
2: by generalize (IN_I H); basic_solver 12.
induction H; [|basic_solver].
desf; apply (wf_colE l) in H0; unfolder in H0; desf; eauto.
Qed.

Lemma wf_new_colD l : new_col l ≡ ⦗W_ l⦘ ⨾ new_col l ⨾ ⦗W_ l⦘.
Proof using IT wf_coD.
apply dom_helper_3.
unfold new_col, pref_union, col0; unfolder; ins; desf.
2: by generalize (IN_I H); basic_solver 12.
induction H; [|basic_solver].
desf; apply (wf_colD l) in H0; unfolder in H0; desf; eauto.
Qed.

Lemma wf_new_coll l : new_col l ⊆ same_loc.
Proof using IT wf_coD.
rewrite wf_new_colD; unfold Events.same_loc.
unfolder; ins; desf; congruence.
Qed.

Lemma wf_new_col_total l : is_total (E ∩₁ W ∩₁ Loc_ l) (new_col l).
Proof using IT wf_coD wf_coE wf_co_total.
unfold new_col, pref_union.
unfolder; ins; desf.
destruct (classic (col0 l a b)) as [|X]; eauto 8.
destruct (classic (col0 l b a)) as [|Y]; eauto 8.
assert (XX: ~ (⦗I⦘ ⨾ col l ⨾ ⦗I⦘ ∪ ⦗T⦘ ⨾ col l ⨾ ⦗T⦘ ∪ ⦗I⦘ ⨾ col l ⨾ ⦗T⦘) a b).
by intro; eapply X; vauto.
assert (YY: ~ (⦗I⦘ ⨾ col l ⨾ ⦗I⦘ ∪ ⦗T⦘ ⨾ col l ⨾ ⦗T⦘ ∪ ⦗I⦘ ⨾ col l ⨾ ⦗T⦘) b a).
by intro; eapply Y; vauto.

assert (Ta: ~ I a -> T a).
by assert (S: (E ∩₁ W) a) by basic_solver; apply IT in S; unfolder in S; ins; desf.
assert (Tb: ~ I b -> T b).
by assert (S: (E ∩₁ W) b) by basic_solver; apply IT in S; unfolder in S; ins; desf.

assert (TOT: col l a b \/ col l b a).
by apply wf_col_total; basic_solver.
destruct (classic (I a)), (classic (I b)); desf.
- exfalso; unfolder in XX; basic_solver 22.
- exfalso; unfolder in YY; basic_solver 22.
- exfalso; unfolder in XX; basic_solver 22.
- eauto 20.
- eauto 20.
- exfalso; unfolder in YY; basic_solver 22.
- exfalso; unfolder in XX; basic_solver 22.
- exfalso; unfolder in YY; basic_solver 22.
Qed.

Lemma new_col_trans l : transitive (new_col l).
Proof using IT co_irr co_trans wf_coD wf_coE wf_co_total.
apply transitiveI; unfolder; ins; desf.
eapply tot_ex.
- apply wf_new_col_total.
- hahn_rewrite wf_new_colE in H0.
hahn_rewrite wf_new_colD in H0.
unfolder in H0; basic_solver 21.
- hahn_rewrite wf_new_colE in H.
hahn_rewrite wf_new_colD in H.
unfolder in H; basic_solver 21.
- intro.
eapply acyclic_new_col.
eapply t_trans, t_trans; vauto.
- intro.
eapply acyclic_new_col.
eapply t_trans; vauto.
Qed.

Lemma new_col_irr l : irreflexive (new_col l).
Proof using IT co_irr co_trans wf_coD wf_coE wf_co_total.
red; ins; eapply acyclic_new_col; vauto.
Qed.

Lemma wf_new_coE : new_co ≡ ⦗E⦘ ⨾ new_co ⨾ ⦗E⦘.
Proof using IT wf_coE.
unfold new_co; unfolder; ins; desf; splits; ins; desf; eauto.
apply (wf_new_colE l) in H; unfolder in H; desf; eauto.
Qed.

Lemma wf_new_coD : new_co ≡ ⦗W⦘ ⨾ new_co ⨾ ⦗W⦘.
Proof using IT wf_coD.
unfold new_co; unfolder; ins; desf; splits; ins; desf; eauto.
apply (wf_new_colD l) in H; unfolder in H; desf; eauto.
Qed.

Lemma wf_new_col : new_co ⊆ same_loc.
Proof using IT wf_coD.
unfold new_co; unfolder; ins; desf; splits; ins; desf; eauto.
apply (@wf_new_coll l) in H; unfolder in H; desf; eauto.
Qed.

Lemma new_co_trans : transitive new_co.
Proof using IT co_irr co_trans wf_coD wf_coE wf_co_total.
unfold new_co; unfolder; ins; desf; splits; ins; desf; eauto.
hahn_rewrite wf_new_colD in H0.
hahn_rewrite wf_new_colD in H.
unfolder in H0; unfolder in H; desf.
exists l; eapply new_col_trans; eauto.
Qed.

Lemma wf_new_co_total : forall ol, is_total (E ∩₁ W ∩₁ (fun x => loc x = ol)) new_co.
Proof using IT wf_coD wf_coE wf_co_total.
unfold new_co; ins; unfolder; ins; desf.
generalize (is_w_loc lab a IWa1); ins; desf.
cut (new_col l a b \/ new_col l b a); [by basic_solver 21|].
apply wf_new_col_total; auto.
basic_solver.
unfolder; splits; ins; desf; congruence.
Qed.

Lemma new_co_irr : irreflexive new_co.
Proof using IT co_irr co_trans wf_coD wf_coE wf_co_total.
unfold new_co; ins; unfolder; ins; desf.
eapply new_col_irr; eauto.
Qed.

Lemma new_co_I : new_co ⨾ ⦗ I ⦘  ⊆ co ⨾ ⦗ I ⦘.
Proof using IT co_irr co_trans wf_coD wf_coE wf_co_total.
unfolder; intros x y [R K]; desf.
unfold new_co in R; desc.
hahn_rewrite wf_new_colE in R.
hahn_rewrite wf_new_colD in R.
unfolder in R; desf; splits; auto.
eapply tot_ex.
- apply wf_co_total.
- basic_solver.
- unfolder; splits; eauto; congruence.
- intro.
assert (S: (E ∩₁ W) z) by basic_solver.
apply IT in S; unfolder in S; ins; desf.
* eapply new_col_irr, new_col_trans; try edone.
red; red; unfold col0, col; left; apply t_step; basic_solver 12.
* eapply new_col_irr, new_col_trans; try edone.
red; red; unfold col0, col; left; apply t_step; basic_solver 12.
- intro; subst.
eby eapply new_col_irr.
Qed.

Lemma T_new_co : ⦗ T ⦘ ⨾ new_co  ⊆ ⦗ T ⦘ ⨾ co.
Proof using IT co_irr co_trans wf_coD wf_coE wf_co_total.
unfolder; intros x y [K1 R]; desf.
unfold new_co in R; desc.
hahn_rewrite wf_new_colE in R.
hahn_rewrite wf_new_colD in R.
unfolder in R; desf; splits; auto.
eapply tot_ex.
- apply wf_co_total.
- basic_solver.
- unfolder; splits; eauto; congruence.
- intro.
assert (S: (E ∩₁ W) z) by basic_solver.
apply IT in S; unfolder in S; ins; desf.
* eapply new_col_irr, new_col_trans; try edone.

red; red; unfold col0, col. left; apply t_step.
assert (I y \/ T y) by (apply IT; basic_solver).
desf; basic_solver 12.
* eapply new_col_irr, new_col_trans; try edone.
red; red; unfold col0, col; left; apply t_step.
assert (I y \/ T y) by (apply IT; basic_solver).
desf; basic_solver 12.
- intro; subst.
eby eapply new_col_irr.
Qed.

Lemma new_co_in : new_co  ⊆ co ⨾ ⦗ I ⦘ ∪
⦗ T ⦘ ⨾ co ∪ ⦗ I \₁ T ⦘ ⨾ new_co ⨾ ⦗ T \₁ I ⦘.
Proof using IT co_irr co_trans wf_coD wf_coE wf_co_total.
rewrite (wf_new_coD), (wf_new_coE) at 1.
rewrite !seqA.
arewrite (⦗W⦘ ⨾ ⦗E⦘ ⊆ ⦗E ∩₁ W⦘) by basic_solver.
arewrite (⦗E⦘ ⨾ ⦗W⦘ ⊆ ⦗E ∩₁ W⦘) by basic_solver.
rewrite <- IT.

arewrite (I ∪₁ T ⊆₁ (I \₁ T) ∪₁ T) at 1.
unfolder; ins; desf; tauto.

arewrite (I ∪₁ T ⊆₁ (T \₁ I) ∪₁ I) at 1.
unfolder; ins; desf; tauto.

rewrite !id_union; relsf.

sin_rewrite !T_new_co.
sin_rewrite new_co_I.
basic_solver 21.
Qed.

Lemma T_I_col0_I_T l :
  ⦗ T \₁ I ⦘ ⨾ col0 l ⨾ ⦗ I \₁ T ⦘  ⊆
  ⦗ T \₁ I ⦘ ⨾ col l ⨾ ⦗ I ∩₁ T ⦘ ⨾ col l ⨾ ⦗ I \₁ T ⦘.
Proof using co_trans.
unfold col0 at 1.
arewrite (⦗T⦘ ⊆ ⦗T \₁ I⦘ ∪ ⦗I ∩₁ T⦘) at 2.
unfolder; ins ;desf; tauto.
relsf.
rewrite <- !unionA.
rewrite unionC.
rewrite <- !unionA.
rewrite path_ut_first; relsf; unionL.
- transitivity (∅₂ : actid -> actid -> Prop); [|basic_solver].
  rewrite path_ut_last; relsf; unionL.
  rewrite ct_begin; basic_solver.
  rewrite (rtE (⦗I⦘ ⨾ col l ⨾ ⦗T⦘ ∪ ⦗I⦘ ⨾ col l ⨾ ⦗I⦘)).
  relsf; unionL.
  basic_solver.
  rewrite ct_begin; basic_solver.
- arewrite (⦗I⦘ ⨾ col l ⨾ ⦗T⦘ ∪ ⦗I⦘ ⨾ col l ⨾ ⦗I⦘ ∪ ⦗T⦘ ⨾ col l ⨾ ⦗T \₁ I⦘ ⊆ col l).
  basic_solver.
  arewrite (col l ∪ ⦗T⦘ ⨾ col l ⨾ ⦗I ∩₁ T⦘ ⊆ col l).
  basic_solver.
  generalize (@col_trans l); ins; relsf.
  basic_solver 21.
Qed.

Lemma T_I_new_col_I_T l :
  ⦗ T \₁ I ⦘ ⨾ new_col l ⨾ ⦗ I \₁ T ⦘  ⊆
  col l ⨾ ⦗ I ∩₁ T ⦘ ⨾ col l.
Proof using co_trans.
unfold new_col, pref_union.
unfolder; ins; desf.
assert (A: (⦗ T \₁ I ⦘ ⨾ col0 l ⨾ ⦗ I \₁ T ⦘) x y) by basic_solver.
apply T_I_col0_I_T in A; unfolder in A; basic_solver 10.
Qed.

Lemma T_I_new_co_I_T :
  ⦗ T \₁ I ⦘ ⨾ new_co ⨾ ⦗ I \₁ T ⦘  ⊆
  co ⨾ ⦗ I ∩₁ T ⦘ ⨾ co.
Proof using co_trans.
unfold new_co.
unfolder; ins; desf.
assert (A: (⦗ T \₁ I ⦘ ⨾ new_col l ⨾ ⦗ I \₁ T ⦘) x y) by basic_solver.
apply T_I_new_col_I_T in A; unfolder in A; desf.
unfold col in *; unfolder in *; desf; eauto 10.
Qed.

Lemma co_for_split: codom_rel (⦗set_compl I⦘ ⨾ (immediate new_co)) ⊆₁ T.
Proof using IT wf_coD wf_coE.
unfolder; ins; desf.
destruct (classic (T x)) as [|X]; auto.
exfalso.
hahn_rewrite wf_new_coE in H0.
hahn_rewrite wf_new_coD in H0.
unfolder in H0; desf.
assert (Ix: I x).
by assert (S: (E ∩₁ W) x) by basic_solver; apply IT in S; unfolder in S; ins; desf.
unfold new_co, new_col, pref_union in *; desc.
destruct H4 as [K|]; cycle 1.
by unfolder in H2; basic_solver 21.
unfold col0 in *.
destruct K.
unfolder in H2; basic_solver 21.
eauto 12.
Qed.

Lemma new_col_helper l : ⦗ T ⦘ ⨾ col l ⨾ ⦗ I ∩₁ T ⦘ ⨾ col l ⨾ ⦗ I ⦘ ⊆ new_col l.
Proof using.
unfold new_col, pref_union, col0.
unfolder; ins; left; desf.
eapply t_trans; apply t_step; eauto 15.
Qed.

Lemma new_co_helper : ⦗ T ⦘ ⨾ co ⨾ ⦗ I ∩₁ T ⦘ ⨾ co ⨾ ⦗ I ⦘ ⊆ new_co.
Proof using wf_coD wf_col.
unfold new_co.
unfolder; ins; desf.
apply co_in_col in H0.
apply co_in_col in H2.
desf.
assert (l = l0); subst.
{ hahn_rewrite wf_colD in H0.
  hahn_rewrite wf_colD in H2.
  unfolder in *; desf. }
exists l0.
apply new_col_helper.
basic_solver 12.
Qed.

Lemma I_co_in_new_co : ⦗ I ⦘ ⨾ co ⊆ new_co.
Proof using IT wf_coD wf_coE wf_col.
unfold new_co.
unfolder; ins; desf.
apply co_in_col in H0.
desf.
exists l.
unfold new_col, pref_union, col0.
left.
apply t_step.
destruct (classic (I y)).
basic_solver 11.
right; unfolder; splits; eauto.
hahn_rewrite (wf_colE) in H0.
hahn_rewrite (wf_colD) in H0.
unfolder in H0; desf.
assert ((I ∪₁ T) y).
eapply IT; basic_solver.
unfolder in *; desf.
Qed.

End CO.


From iris.algebra Require Import frac.
From iris.proofmode Require Import tactics.
Require Import Eqdep_dec List.
From cap_machine Require Import rules logrel stack_macros_helpers.
From cap_machine Require Export iris_extra addr_reg_sample contiguous.
From cap_machine Require Import macros.
From cap_machine.binary_model.rules_binary Require Import rules_binary rules_binary_StoreU_derived.

(** This file contains specification side specs for macros.
    The file contains pushz, rclear and prepstack (for now, only the macros needed by example)
 *)

Ltac iPrologue_s prog :=
  (try iPrologue_pre);
  iDestruct prog as "[Hi Hprog]".

Ltac iEpilogue_s :=
   iMod (do_step_pure _ [] with "[$Hspec $Hj]") as "Hj";auto;
   iSimpl in "Hj".

Section macros.
  Context {Σ:gFunctors} {memg:memG Σ} {regg:regG Σ}
          {nainv: logrel_na_invs Σ} {cfg : cfgSG Σ}
          `{MP: MachineParameters}.

  (* --------------------------------------------------------------------------------- *)
  (* --------------------------------------- PUSH ------------------------------------ *)
  (* --------------------------------------------------------------------------------- *)

  Definition pushU_z_s a1 r_stk z : iProp Σ := (a1 ↣ₐ pushU_z_instr r_stk z)%I.

  Lemma pushU_z_spec E a1 a2 w z p g b e stk_b stk_e stk_a stk_a' :
    isCorrectPC (inr ((p,g),b,e,a1)) →
    withinBounds ((URWLX,Directed),stk_b,stk_e,stk_a) = true →
    (a1 + 1)%a = Some a2 →
    (stk_a + 1)%a = Some stk_a' →
    nclose specN ⊆ E →

    spec_ctx
    ∗ ⤇ Seq (Instr Executable)
    ∗ ▷ pushU_z_s a1 r_stk z
    ∗ ▷ PC ↣ᵣ inr ((p,g),b,e,a1)
    ∗ ▷ r_stk ↣ᵣ inr ((URWLX,Directed),stk_b,stk_e,stk_a)
    ∗ ▷ stk_a ↣ₐ w
    ={E}=∗ ⤇ Seq (Instr Executable)
         ∗ PC ↣ᵣ inr ((p,g),b,e,a2) ∗ pushU_z_s a1 r_stk z ∗
         r_stk ↣ᵣ inr ((URWLX,Directed),stk_b,stk_e,stk_a') ∗ stk_a ↣ₐ inl z.
  Proof.
    iIntros (Hvpc1 Hwb Hsuc Hstk Hnclose)
            "(#Hspec & Hj & Ha1 & HPC & Hr_stk & Hstk_a')".
    iMod (step_storeU_success_0_z _ [SeqCtx] with "[$Hspec $Hj $HPC $Ha1 $Hr_stk $Hstk_a']")
      as "(Hj & HPC & Ha1 & Hr_stk & Hstk_a)";
      [apply decode_encode_instrW_inv|eauto..].
    iEpilogue_s.
    iFrame. done.
  Qed.

End macros.


Require Import floyd.proofauto.
Import ListNotations.
Local Open Scope logic.

Require Import hmac_drbg.
Require Import spec_hmac_drbg.

Lemma sublist_app_exact1:
  forall X (A B: list X), sublist 0 (Zlength A) (A ++ B) = A.
Proof.
  intros.
  pose proof (Zlength_nonneg A).
  rewrite sublist_app1; try omega.
  rewrite sublist_same; auto.
Qed.

Lemma sublist_app_exact2:
  forall X (A B: list X), sublist (Zlength A) (Zlength A + Zlength B) (A ++ B) = B.
Proof.
  intros.
  pose proof (Zlength_nonneg A).
  pose proof (Zlength_nonneg B).
  rewrite sublist_app2; try omega.
  rewrite sublist_same; auto; omega.
Qed.

Lemma isbyteZ_app: forall A B, Forall general_lemmas.isbyteZ A -> Forall general_lemmas.isbyteZ B -> Forall general_lemmas.isbyteZ (A ++ B).
Proof.
  intros A B HA HB.
  induction A as [|hdA tlA].
  simpl; assumption.
  simpl. inversion HA. constructor.
  assumption.
  apply IHtlA.
  assumption.
Qed.

Check data_at_valid_ptr.
Lemma data_at_weak_valid_ptr: forall (sh : Share.t) (t : type) (v : reptype t) (p : val),
       sepalg.nonidentity sh ->
       sizeof cenv_cs t >= 0 -> data_at sh t v p |-- weak_valid_pointer p.
Proof.
Admitted.
Hint Resolve data_at_weak_valid_ptr: valid_pointer.

Lemma data_at_complete_split:
  forall A B lengthA lengthB AB length p offset sh,
    field_compatible (tarray tuchar (Zlength A + Zlength B)) [] p ->
    lengthA = Zlength A ->
    lengthB = Zlength B ->
    length = lengthA + lengthB ->
    offset = lengthA ->
    AB = A ++ B ->
    (data_at sh (tarray tuchar length) (AB) p) = (data_at sh (tarray tuchar lengthA) A p) * (data_at sh (tarray tuchar lengthB) B (offset_val (Int.repr offset) p)).
Proof.
  intros until sh.
  intros Hfield.
  intros; subst.
  pose proof (Zlength_nonneg A).
  pose proof (Zlength_nonneg B).
  assert (Hisptr: isptr p) by (destruct Hfield; assumption).
  destruct p; try solve [inversion Hisptr]; clear Hisptr.
  unfold tarray.
  rewrite split2_data_at_Tarray_tuchar with (n1:=Zlength A); [|split; omega|rewrite Zlength_app; reflexivity].
  rewrite sublist_app_exact1, sublist_app_exact2.
  replace (Zlength A + Zlength B - Zlength A) with (Zlength B) by omega.
  replace (field_address0 (Tarray tuchar (Zlength A + Zlength B) noattr) [ArraySubsc (Zlength A)] (Vptr b i)) with (Vptr b (Int.add i (Int.repr (Zlength A)))).
  reflexivity.
  rewrite field_address0_offset.
  simpl. replace (0 + 1 * Zlength A) with (Zlength A) by omega. reflexivity.
  destruct Hfield as [Hfield1 [Hfield2 [Hfield3 [Hfield4 [Hfield5 [Hfield6 [Hfield7 Hfield8]]]]]]].
  unfold field_compatible0; repeat split; try assumption; auto; omega.
Qed.

Lemma body_hmac_drbg_reseed: semax_body HmacDrbgVarSpecs HmacDrbgFunSpecs
       f_mbedtls_hmac_drbg_reseed hmac_drbg_reseed_spec.
Proof.
  start_function.

  name ctx' _ctx.
  name add_len' _len.
  name additional' _additional.

  rename lvar0 into seed.
  destruct initial_state_abs.
  destruct initial_state as [md_ctx' [V' [reseed_counter' [entropy_len' [prediction_resistance' reseed_interval']]]]].
  unfold hmac256drbg_relate.
  normalize.

  (* entropy_len = ctx->entropy_len *)
  forward.

  remember (if zlt 256 add_len then true else false) as add_len_too_high.

  (* if (len > MBEDTLS_HMAC_DRBG_MAX_INPUT ||
        entropy_len + len > MBEDTLS_HMAC_DRBG_MAX_SEED_INPUT) *)
  forward_if (PROP  ()
      LOCAL  (temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      temp 146%positive (Val.of_bool add_len_too_high);
      gvar sha._K256 kv)
      SEP  (data_at_ Tsh (tarray tuchar 384) seed;
      data_at Tsh (tarray tuchar add_len) (map Vint (map Int.repr contents))
        additional;
      data_at Tsh t_struct_hmac256drbg_context_st
        (md_ctx',
        (map Vint (map Int.repr V),
        (Vint (Int.repr reseed_counter),
        (Vint (Int.repr entropy_len),
        (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))) ctx;
      md_full key md_ctx';
      data_at Tsh t_struct_mbedtls_md_info info_contents
        (hmac256drbgstate_md_info_pointer
           (md_ctx',
           (map Vint (map Int.repr V),
           (Vint (Int.repr reseed_counter),
           (Vint (Int.repr entropy_len),
           (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))));
      Stream s; spec_sha.K_vector kv)
  ).
  {
    rewrite zlt_true in Heqadd_len_too_high by assumption.
    forward.
    entailer!.
  }
  {
    rewrite zlt_false in Heqadd_len_too_high by assumption.
    forward.
    entailer!.
    rewrite <- H12.
    simpl in H2. subst entropy_len.
    unfold Int.ltu.
    destruct (zlt (Int.unsigned (Int.repr 384))
                 (Int.unsigned (Int.repr (32 + Zlength contents)))).
    rewrite Int.unsigned_repr_eq in l.
    rewrite Zmod_small in l by auto.
    rewrite Int.unsigned_repr_eq in l.
    rewrite Zmod_small in l.
    omega.
    assert (0 <= Zlength contents <= 256) by omega.
    rewrite hmac_pure_lemmas.IntModulus32. simpl.
    change (Z.pow_pos 2 32) with 4294967296.
    omega.
    reflexivity.
  }

  forward_if (PROP  (add_len_too_high = false)
      LOCAL  (temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      gvar sha._K256 kv)
      SEP  (data_at_ Tsh (tarray tuchar 384) seed;
      data_at Tsh (tarray tuchar add_len) (map Vint (map Int.repr contents))
        additional;
      data_at Tsh t_struct_hmac256drbg_context_st
        (md_ctx',
        (map Vint (map Int.repr V),
        (Vint (Int.repr reseed_counter),
        (Vint (Int.repr entropy_len),
        (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))) ctx;
      md_full key md_ctx';
      data_at Tsh t_struct_mbedtls_md_info info_contents
        (hmac256drbgstate_md_info_pointer
           (md_ctx',
           (map Vint (map Int.repr V),
           (Vint (Int.repr reseed_counter),
           (Vint (Int.repr entropy_len),
           (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))));
      Stream s; spec_sha.K_vector kv)
  ).
  {
    forward.
    unfold hmac_drbg_update_post, get_stream_result, hmac256drbg_relate.
    Exists seed (Vint (Int.neg (Int.repr 5))).
    rewrite andb_negb_r.
    destruct (zlt 256 (Zlength contents)); inv Heqadd_len_too_high.
    rewrite Z.gtb_ltb.
    assert (Hlt: 256 <? Zlength contents = true) by (apply Z.ltb_lt; assumption).
    rewrite Hlt.
    unfold hmac256drbgabs_to_state.
    entailer!.
  }
  {
    forward.
    entailer!.
  }
  assert_PROP (0 <= Zlength contents <= 256) as HZlength.
  {
    entailer!. destruct (zlt 256 (Zlength contents)); inversion H11. omega.
  }

  (* memset( seed, 0, MBEDTLS_HMAC_DRBG_MAX_SEED_INPUT ); *)
  forward_call (Tsh, seed, 384, Int.zero).
  {
    rewrite data_at__memory_block.
    change (sizeof cenv_cs (tarray tuchar 384)) with 384.
    entailer!.
  }
  Intros vret; subst vret.

  assert_PROP (field_compatible (tarray tuchar 384) [] seed) as Hfield by entailer!.
  replace_SEP 0 ((data_at Tsh (tarray tuchar entropy_len)
         (list_repeat (Z.to_nat entropy_len) (Vint Int.zero)) seed) * (data_at Tsh (tarray tuchar (384 - entropy_len))
         (list_repeat (Z.to_nat (384 - entropy_len)) (Vint Int.zero)) (offset_val (Int.repr entropy_len) seed))).
  {
    simpl in H2.
    subst entropy_len.
    entailer!.
    apply derives_refl'; apply data_at_complete_split; auto.
  }
  normalize.

  replace_SEP 0 (memory_block Tsh entropy_len seed).
  {
    entailer!.
    simpl in H2; subst entropy_len.
    apply data_at_memory_block.
  }

  (* get_entropy(seed, entropy_len ) *)
  forward_call (Tsh, s, seed, entropy_len).
  {
    simpl in H2; subst entropy_len.
    auto.
  }
  Intros vret.

  (* if( get_entropy(seed, entropy_len ) != 0 ) *)
  forward_if (
      PROP  (vret=Vzero)
      LOCAL  (temp 147%positive vret;
      temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      gvar sha._K256 kv)
      SEP
      (Stream
         (get_stream_result
            (entropy.get_entropy 0 entropy_len entropy_len false s));
      match entropy.ENTROPY.get_bytes (Z.to_nat entropy_len) s with
      | entropy.ENTROPY.success bytes _ =>
          data_at Tsh (tarray tuchar entropy_len)
            (map Vint (map Int.repr bytes)) seed
      | entropy.ENTROPY.error _ _ => memory_block Tsh entropy_len seed
      end;
      data_at Tsh (tarray tuchar (384 - entropy_len))
        (list_repeat (Z.to_nat (384 - entropy_len)) (Vint Int.zero))
        (offset_val (Int.repr entropy_len) seed);
      data_at Tsh (tarray tuchar add_len) (map Vint (map Int.repr contents))
        additional;
      data_at Tsh t_struct_hmac256drbg_context_st
        (md_ctx',
        (map Vint (map Int.repr V),
        (Vint (Int.repr reseed_counter),
        (Vint (Int.repr entropy_len),
        (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))) ctx;
      md_full key md_ctx';
      data_at Tsh t_struct_mbedtls_md_info info_contents
        (hmac256drbgstate_md_info_pointer
           (md_ctx',
           (map Vint (map Int.repr V),
           (Vint (Int.repr reseed_counter),
           (Vint (Int.repr entropy_len),
           (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))));
      spec_sha.K_vector kv)
  ).
  {
    (* != 0 case *)
    forward.
    unfold hmac_drbg_update_post.
    Exists seed (Vint (Int.neg (Int.repr (9)))).
    unfold entropy.get_entropy in *.
    destruct (entropy.ENTROPY.get_bytes (Z.to_nat entropy_len) s).
    {
      (* contradiction. cannot be a success *)
      hnf in H11.
      inv H11.
      inversion H12.
    }
    rewrite andb_negb_r.
    destruct (zlt 256 (Zlength contents)); inv Heqadd_len_too_high.
    rewrite Z.gtb_ltb.
    assert (Hlt: 256 <? Zlength contents = false) by (apply Z.ltb_nlt; assumption).
    rewrite Hlt.
    unfold hmac256drbg_relate, get_stream_result.
    rewrite data_at__memory_block.
    unfold hmac256drbgabs_to_state.
    entailer!.
    eapply derives_trans. apply sepcon_derives; [apply derives_refl | apply data_at_memory_block].
    apply derives_refl'.
    destruct seed; inv Pseed.
    simpl.
    rewrite <- repr_unsigned with (i:=i).
    simpl in H2; subst entropy_len.
    change (1 * Z.max 0 (384 - 32))%Z with 352.
    rewrite add_repr.
    rewrite <- memory_block_split; auto.
    clear - H14. rename H14 into Hlvar.
    unfold lvar in Hlvar; unfold size_compatible in Hlvar.
    destruct (Map.get (ve_of rho) _seed); try solve [inversion Hlvar].
    destruct p. destruct (eqb_type (tarray tuchar 384) t); try solve [inversion Hlvar].
    destruct Hlvar as [Hblock Hsize].
    simpl in Hsize.
    assert (Int.unsigned i >= 0) by (pose proof (Int.unsigned_range i); omega).
    omega.
  }
  {
    forward.
    entailer!.
    replace _id with Int.zero; [reflexivity|].
    clear - H12. rename H12 into Hid.
    pose proof (negb_sym (Int.eq _id (Int.repr 0)) false).
    symmetry in Hid; apply H in Hid.
    simpl in Hid.
    symmetry; apply binop_lemmas2.int_eq_true.
    auto.
  }

  (* now that we know entropy call succeeded, use that fact to simplify the SEP clause *)
  remember (entropy.ENTROPY.get_bytes (Z.to_nat entropy_len) s) as entropy_result.
  unfold entropy.get_entropy in H11;
  rewrite <- Heqentropy_result in H11;
  destruct entropy_result; [|
  normalize;
  simpl in H11; destruct e; [inversion H11 |
  assert (contra: False) by (apply H11; reflexivity); inversion contra]
  ].

  rename l into entropy_bytes.

  assert (Hentropy_bytes_length: Zlength (map Vint (map Int.repr entropy_bytes)) = 32).
  {
    repeat rewrite Zlength_map.
    eapply entropy.ENTROPY.get_bytes_Zlength.
    omega.
    simpl in H2; subst entropy_len.
    eassumption.
  }

  gather_SEP 1 2.
  replace_SEP 0 (data_at Tsh (tarray tuchar 384)
         ((map Vint
            (map Int.repr entropy_bytes)) ++ (list_repeat (Z.to_nat (384 - entropy_len)) (Vint Int.zero))) seed).
  {
    simpl in H2.
    subst entropy_len.
    entailer!.
    apply derives_refl'; symmetry; apply data_at_complete_split; auto.
    replace (Zlength (map Vint (map Int.repr entropy_bytes))) with 32 by assumption.
    auto.
  }

  (* seedlen = entropy_len; *)
  forward.

  remember (if eq_dec additional nullval then false else if eq_dec add_len 0 then false else true) as non_empty_additional.

  (* if additional != null *)
  forward_if (
      PROP  ()
      LOCAL  (temp _seedlen (Vint (Int.repr entropy_len));
      temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      temp 148%positive (Val.of_bool non_empty_additional);
      gvar sha._K256 kv)
      SEP  (
        data_at Tsh (tarray tuchar 384)
         (map Vint (map Int.repr entropy_bytes) ++
          list_repeat (Z.to_nat (384 - entropy_len)) (Vint Int.zero)) seed;
        Stream
        (get_stream_result
           (entropy.get_entropy 0 entropy_len entropy_len false s));
      data_at Tsh (tarray tuchar add_len) (map Vint (map Int.repr contents))
        additional;
      data_at Tsh t_struct_hmac256drbg_context_st
        (md_ctx',
        (map Vint (map Int.repr V),
        (Vint (Int.repr reseed_counter),
        (Vint (Int.repr entropy_len),
        (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))) ctx;
      md_full key md_ctx';
      data_at Tsh t_struct_mbedtls_md_info info_contents
        (hmac256drbgstate_md_info_pointer
           (md_ctx',
           (map Vint (map Int.repr V),
           (Vint (Int.repr reseed_counter),
           (Vint (Int.repr entropy_len),
           (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))));
      spec_sha.K_vector kv)
  ).
  {
    (* TODO this should be easy with weakly valid pointer *)
    unfold denote_tc_comparable.
    assert_PROP (isptr additional) as Hisptr by entailer!. destruct additional; try solve [inversion Hisptr]; clear Hisptr.
    entailer!.
    admit.
  }
  {
    forward.
    entailer!.
    rewrite <- H14.
    destruct (eq_dec additional' nullval) as [additional_pos | additional_neg].
    subst additional'; assert (contra: False) by (apply H12; reflexivity); inversion contra.
    destruct (eq_dec (Zlength contents) 0) as [Zlength_pos | Zlength_neg].
    rewrite Zlength_pos. reflexivity.
    rewrite Int.eq_false. reflexivity.
    intros contra.
    apply repr_inj_unsigned in contra; omega.
  }
  {
    forward.
    entailer!.
    destruct (eq_dec nullval nullval).
    reflexivity.
    assert (contra: False) by auto; inversion contra.
  }

  forward_if (
      PROP  ()
      LOCAL  (temp _seedlen (Vint (Int.repr (entropy_len + Zlength contents)));
      temp _entropy_len (Vint (Int.repr entropy_len));
      lvar _seed (tarray tuchar 384) seed; temp _ctx ctx;
      temp _additional additional; temp _len (Vint (Int.repr add_len));
      gvar sha._K256 kv)
      SEP
      (data_at Tsh (tarray tuchar 384)
         (map Vint
            (map Int.repr entropy_bytes) ++ (map Vint (map Int.repr contents)) ++
          list_repeat (Z.to_nat (384 - entropy_len - Zlength contents)) (Vint Int.zero)) seed;
      Stream
     (get_stream_result
        (entropy.get_entropy 0 entropy_len entropy_len false s));
      data_at Tsh (tarray tuchar add_len) (map Vint (map Int.repr contents))
        additional;
      data_at Tsh t_struct_hmac256drbg_context_st
        (md_ctx',
        (map Vint (map Int.repr V),
        (Vint (Int.repr reseed_counter),
        (Vint (Int.repr entropy_len),
        (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))) ctx;
      md_full key md_ctx';
      data_at Tsh t_struct_mbedtls_md_info info_contents
        (hmac256drbgstate_md_info_pointer
           (md_ctx',
           (map Vint (map Int.repr V),
           (Vint (Int.repr reseed_counter),
           (Vint (Int.repr entropy_len),
           (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))));
      spec_sha.K_vector kv)
  ).
  {
    replace_SEP 0 ((data_at Tsh (tarray tuchar entropy_len)
         (map Vint
            (map Int.repr entropy_bytes)) seed) * (data_at Tsh (tarray tuchar (384 - entropy_len))
         (list_repeat (Z.to_nat (384 - entropy_len)) (Vint Int.zero)) (offset_val (Int.repr entropy_len) seed))).
    {
      entailer!.
      simpl in H2.
      subst entropy_len.
      replace (384 - 32) with 352 by omega.
      apply derives_refl'; apply data_at_complete_split; auto.
      rewrite Hentropy_bytes_length.
      auto.
    }
    normalize.
    assert_PROP (isptr seed) as Hisptr by entailer!. destruct seed; try solve [inversion Hisptr]; change (offset_val (Int.repr entropy_len) (Vptr b i)) with (Vptr b (Int.add i (Int.repr entropy_len))).
    assert_PROP (field_compatible (Tarray tuchar (384 - entropy_len) noattr)
          [] (Vptr b (Int.add i (Int.repr entropy_len)))) by entailer!.
    replace_SEP 1 ((data_at Tsh (tarray tuchar (Zlength contents))
         (list_repeat (Z.to_nat (Zlength contents)) (Vint Int.zero)) (Vptr b (Int.add i (Int.repr entropy_len)))) * (data_at Tsh (tarray tuchar (384 - entropy_len - Zlength contents))
         (list_repeat (Z.to_nat (384 - entropy_len - Zlength contents)) (Vint Int.zero)) (offset_val (Int.repr (Zlength contents)) (Vptr b (Int.add i (Int.repr entropy_len)))))).
    {
      simpl in H2; subst entropy_len.
      replace (384 - 32) with 352 by omega.
      remember (Vptr b (Int.add i (Int.repr 32))) as seed'.
      clear Heqseed'.
      entailer!.
      replace (length contents) with (Z.to_nat (Zlength contents)) by
        (rewrite Zlength_correct; apply Nat2Z.id).
      apply derives_refl'; apply data_at_complete_split; repeat rewrite Zlength_list_repeat; try omega; auto.
      {
        replace (Zlength contents + (352 - Zlength contents)) with (384 - 32) by omega.
        assumption.
      }
      {
        rewrite list_repeat_app.
        rewrite <- Z2Nat.inj_add; try omega.
        replace (Zlength contents + (352 - Zlength contents)) with 352 by omega.
        reflexivity.
      }
    }
    normalize.
    replace_SEP 0 (memory_block Tsh (Zlength contents) (Vptr b (Int.add i (Int.repr entropy_len)))).
    entailer!. replace (Zlength contents) with (sizeof cenv_cs (tarray tuchar (Zlength contents))) at 2. apply data_at_memory_block. simpl. rewrite Zmax0r by omega. omega.
    forward_call ((Tsh, Tsh), (Vptr b (Int.add i (Int.repr entropy_len))), additional, Zlength contents, map Int.repr contents).
    {
      (* type checking *)
      unfold lvar in H15.
      unfold eval_var.
      destruct (Map.get (ve_of rho) _seed); [|inversion H15].
      destruct p.
      destruct (eqb_type (tarray tuchar 384)); [|inversion H15].
      simpl. constructor.
    }
    {
      (* match up function parameter *)
      simpl in H2; rewrite H2.
      entailer!.
    }
    {
      (* match up SEP clauses *)
      change (fst (Tsh, Tsh)) with Tsh;
      change (snd (Tsh, Tsh)) with Tsh.
      change (@data_at spec_sha.CompSpecs Tsh (tarray tuchar (@Zlength Z contents))
         (@map int val Vint (@map Z int Int.repr contents)) additional) with (@data_at hmac_drbg_compspecs.CompSpecs Tsh (tarray tuchar (@Zlength Z contents))
         (@map int val Vint (@map Z int Int.repr contents)) additional).
      rewrite H1.
      cancel.
    }
    {
      (* prove the PROP clauses *)
      repeat split; auto; omega.
    }
    Intros memcpy_vret. subst memcpy_vret.
    forward.
    change (fst (Tsh, Tsh)) with Tsh;
    change (snd (Tsh, Tsh)) with Tsh.
    change (@data_at spec_sha.CompSpecs Tsh (tarray tuchar (@Zlength Z contents))
         (@map int val Vint (@map Z int Int.repr contents)) additional) with (@data_at hmac_drbg_compspecs.CompSpecs Tsh (tarray tuchar (@Zlength Z contents))
         (@map int val Vint (@map Z int Int.repr contents)) additional).
    gather_SEP 1 2.
    replace_SEP 0 (data_at Tsh (tarray tuchar (384 - entropy_len)) ((map Vint (map Int.repr contents)) ++ (list_repeat (Z.to_nat (384 - entropy_len - Zlength contents)) (Vint Int.zero))) (Vptr b (Int.add i (Int.repr entropy_len)))).
    {
      simpl in H2; subst entropy_len.
      replace (384 - 32) with 352 by omega.
      remember (Vptr b (Int.add i (Int.repr 32))) as seed'.
      clear Heqseed'.
      entailer!.
      apply derives_refl'; symmetry; apply data_at_complete_split; repeat rewrite Zlength_list_repeat; try omega; auto.
      change ((fix map (l : list int) : list val :=
               match l with
               | [] => []
               | a :: t => Vint a :: map t
               end) (map Int.repr contents)) with (map Vint (map Int.repr contents)).
      repeat rewrite Zlength_map.
      replace (Zlength contents + (352 - Zlength contents)) with 352 by omega.
      assumption.
    }
    change (Vptr b (Int.add i (Int.repr entropy_len))) with (offset_val (Int.repr entropy_len) (Vptr b i)). remember (Vptr b i) as seed; clear Heqseed.
    gather_SEP 2 0.
    replace_SEP 0 (data_at Tsh (tarray tuchar 384) ((map Vint
         (map Int.repr entropy_bytes)) ++ (map Vint (map Int.repr contents) ++
       list_repeat (Z.to_nat (384 - entropy_len - Zlength contents))
         (Vint Int.zero))) seed).
    {
      simpl in H2;
      subst entropy_len.
      replace (384 - 32) with 352 by omega.
      entailer!.
      apply derives_refl'; symmetry; apply data_at_complete_split; repeat rewrite Zlength_list_repeat; try omega; auto.
      rewrite Hentropy_bytes_length.
      rewrite Zlength_app; rewrite Zlength_list_repeat; repeat rewrite Zlength_map; try omega.
      replace (32 +
         (Zlength contents + (352 - Zlength contents))) with 384 by omega.
      assumption.
    }
    entailer!.
  }
  {
    forward.
    assert_PROP (contents = []).
    {
      destruct (eq_dec additional nullval). entailer!. destruct H20 as [contra H20']; inversion contra.
      destruct (eq_dec add_len 0). entailer!. destruct contents; [reflexivity|]. rewrite Zlength_correct in e; simpl in e. inversion e.
      rewrite H12 in Heqnon_empty_additional. inversion Heqnon_empty_additional.
    }
    subst contents.
    change (Zlength []) with 0.
    replace (384 - entropy_len - 0) with (384 - entropy_len) by omega.
    entailer!.
  }

  replace_SEP 0 (
    (data_at Tsh (tarray tuchar (entropy_len + Zlength contents)) (map Vint
            (map Int.repr entropy_bytes) ++
            map Vint (map Int.repr contents)) seed) *
    (data_at Tsh (tarray tuchar (384 - (entropy_len + Zlength contents))) (list_repeat (Z.to_nat (384 - entropy_len - Zlength contents))
            (Vint Int.zero)) (offset_val (Int.repr (entropy_len + Zlength contents)) seed))
      ).
  {
    simpl in H2; subst entropy_len.
    replace (384 - (32 + Zlength contents)) with (352 - Zlength contents) by omega.
    replace (384 - 32) with 352 by omega.
    rewrite app_assoc.
    entailer!.
    apply derives_refl'; apply data_at_complete_split; repeat rewrite Zlength_list_repeat; try omega; auto; rewrite Zlength_app; rewrite Hentropy_bytes_length; repeat rewrite Zlength_map; auto.
    replace (32 + Zlength contents + (352 - Zlength contents)) with 384 by omega.
    assumption.
  }
  normalize.

  do 2 rewrite map_map.
  rewrite <- map_app.
  rewrite <- map_map.

  forward_call ((entropy_bytes ++ contents), seed, (entropy_len + Zlength contents), ctx, (md_ctx',
        (map Vint (map Int.repr V),
        (Vint (Int.repr reseed_counter),
        (Vint (Int.repr entropy_len),
        (Val.of_bool prediction_resistance, Vint (Int.repr reseed_interval)))))), (HMAC256DRBGabs key V reseed_counter entropy_len prediction_resistance reseed_interval), kv, info_contents).
  {
    (* prove the SEP clauses match up *)
    unfold hmac256drbg_relate.
    entailer!.
  }
  {
    (* prove the PROP clauses *)
    simpl in H2; subst entropy_len.
    rewrite int_max_unsigned_eq.
    repeat split; try omega.
    {
      rewrite Zlength_app.
      repeat rewrite Zlength_map in Hentropy_bytes_length.
      rewrite Hentropy_bytes_length.
      change (Z.of_nat (Z.to_nat 32)) with 32.
      reflexivity.
    }
    {
      simpl; assumption.
    }
    {
      apply isbyteZ_app.
      eapply entropy.ENTROPY.get_bytes_isbyteZ; eauto. assumption.
    }
  }
  unfold hmac_drbg_update_post; normalize.

  gather_SEP 3 5.
  replace_SEP 0 (data_at Tsh (tarray tuchar 384) ((map Vint
         (map Int.repr entropy_bytes)) ++ (map Vint (map Int.repr contents) ++
       list_repeat (Z.to_nat (384 - entropy_len - Zlength contents))
         (Vint Int.zero))) seed).
  {
    simpl in H2;
    subst entropy_len.
    replace (384 - 32) with 352 by omega.
    replace (384 - (32 + Zlength contents)) with (352 - Zlength contents) by omega.
    rewrite app_assoc.
    rewrite map_map.
    rewrite map_app.
    rewrite <- map_map.
    replace (map (fun x : Z => Vint (Int.repr x)) contents) with (map Vint (map Int.repr contents)) by (rewrite map_map; auto).
    entailer!.
    apply derives_refl'; symmetry; apply data_at_complete_split; repeat rewrite Zlength_list_repeat; try omega; auto; rewrite Zlength_app; rewrite Hentropy_bytes_length; repeat rewrite Zlength_map; auto.
    replace (32 + Zlength contents + (352 - Zlength contents)) with 384 by omega.
    assumption.
  }

  (* ctx->reseed_counter = 1; *)
  forward.

  (* return 0 *)
  forward.

  unfold hmac_drbg_update_post.
  unfold hmac256drbgabs_to_state.
  Exists seed (Vint (Int.repr 0)).
  rewrite andb_negb_r.
  assert (HcontentsLength: Zlength contents >? 256 = false).
  {
    rewrite Z.gtb_ltb.
    apply Z.ltb_nlt.
    omega.
  }
  rewrite HcontentsLength.
  unfold HMAC_DRBG_update.HMAC_DRBG_update.
  idtac.
  replace (map (fun x : Z => Vint (Int.repr x)) contents) with (map Vint (map Int.repr contents)) by (rewrite map_map; auto).
  unfold hmac256drbg_relate.
  unfold get_stream_result.
  unfold entropy.get_entropy.
  rewrite <- Heqentropy_result.
  assert (Hnonempty_seed: exists hdSeed tlSeed, (entropy_bytes ++ contents) = hdSeed::tlSeed).
  {
    remember (entropy_bytes ++ contents) as seedContents.
    destruct seedContents as [|hdSeed tlSeed].
    {
      (* this case can't be true. case: seedContents = [] *)
      simpl in H2; subst entropy_len.
      assert (contra: Zlength (entropy_bytes ++ contents) = 0) by (rewrite <- HeqseedContents; reflexivity).
      rewrite Zlength_app in contra.
      repeat rewrite Zlength_map in Hentropy_bytes_length; rewrite Hentropy_bytes_length in contra.
      omega.
    }
    exists hdSeed. exists tlSeed.
    reflexivity.
  }
  unfold HMAC256_DRBG_functional_prog.HMAC256_DRBG_update.
  unfold HMAC_DRBG_update.HMAC_DRBG_update.
  destruct Hnonempty_seed as [hdSeed [tlSeed Hnonempty_seed]];
  rewrite Hnonempty_seed.
  entailer!.
  split; [apply hmac_common_lemmas.HMAC_Zlength| apply hmac_common_lemmas.isbyte_hmac].
Qed.


Require Import Arith.
Require Import Omega.
Require Import String.
Require Import List.
Import ListNotations.

Require Import OrderedType OrderedTypeEx.
Require FMapList.
Require FMapFacts.
Module NatMap := FMapList.Make Nat_as_OT.
Module NatMapFacts := FMapFacts.WFacts_fun Nat_as_OT NatMap.

Require Import ast.

(* ************************************************************ *)
(* ************************************************************ *)
(*                                                              *)
(*                          semantics                           *)
(*                                                              *)
(* ************************************************************ *)
(* ************************************************************ *)

(*
 * We define the semantics in terms of an abstract machine, which
 * includes the evaluation state as well as the program.
 *
 * A machine has a heap and a list of threads.
 * A thread is a lits of stack frames.
 * A stack frame is a local store plus a statement to execute.
 *
 * Statements are executed destructively.
 *)

(**************************************************************)
(* stores *)

Section Stores.

(* old form that used coq types directly
Inductive val: Type := mkval (t: Type) (a : t): val.

Definition Heap := NatMap.t val.
Definition Locals := NatMap.t val.
*)

(* XXX kill this off *)
Inductive val: Type := mkval (t: type) (a : value): val.

Definition Heap := NatMap.t val.
Definition Locals := NatMap.t val.

End Stores.

(**************************************************************)
(* expressions *)

Section Expressions.

Inductive ExprYields: forall t, Locals -> expr -> value -> Prop :=
| value_yields: forall loc t a,
    ExprYields t loc (e_value t a) a
| read_yields: forall loc t (x : var) id a,
    (* XXX tidy this *)
    type_of_value a = t ->
    x = mkvar t id -> NatMap.find id loc = Some (mkval t a) ->
    ExprYields t loc (e_read x) a
| cond_true_yields: forall t loc e et ef a,
    ExprYields t_bool loc e v_true ->
    ExprYields t loc et a ->
    ExprYields t loc (e_cond t e et ef) a
| cond_false_yields: forall t loc e et ef a,
    ExprYields t_bool loc e v_false ->
    ExprYields t loc ef a ->
    ExprYields t loc (e_cond t e et ef) a
.

End Expressions.

(**************************************************************)
(* statements *)

Section Statements.

(* call, return, and start appear at higher levels *)
Inductive StmtSteps: Heap -> Locals -> stmt -> Heap -> Locals -> stmt -> Prop :=
| step_in_seq: forall h loc s1 s2 h' loc' s1',
     StmtSteps h loc s1 h' loc' s1' ->
     StmtSteps h loc (s_seq s1 s2) h' loc' (s_seq s1' s2)
| step_next: forall h loc s2,
     StmtSteps h loc (s_seq s_skip s2) h loc s2
| step_assign: forall h loc id type e a,
     ExprYields type loc e a ->
     StmtSteps h loc (s_assign (mkvar type id) e) h (NatMap.add id (mkval type a) loc) s_skip
| step_load: forall h loc type lid e hid heapnum a,
     (* XXX this is wrong (needs to handle heapnum) *)
     ExprYields type loc e (v_addr (mkaddr type hid heapnum)) ->
     NatMap.find hid h = Some (mkval type a) ->
     StmtSteps h loc (s_load (mkvar type lid) e) h (NatMap.add lid (mkval type a) loc) s_skip
| step_store: forall h loc type lid e hid heapnum a,
     (* XXX this is wrong (needs to handle heapnum) *)
     ExprYields type loc e a ->
     ExprYields type loc (e_read (mkvar type lid)) (v_addr (mkaddr type hid heapnum)) ->
     StmtSteps h loc (s_store (mkvar type lid) e) (NatMap.add hid (mkval type a) h) loc s_skip
| step_scope: forall h loc s h' loc' s',
     StmtSteps h loc s h' loc' s' ->
     StmtSteps h loc (s_scope s) h' loc' (s_scope s')
| step_endscope: forall h loc,
     StmtSteps h loc (s_scope s_skip) h loc s_skip
| step_if_true: forall h loc e st sf,
     ExprYields t_bool loc e v_true ->
     StmtSteps h loc (s_if e st sf) h loc (s_scope st)
| step_if_false: forall h loc e st sf,
     ExprYields t_bool loc e v_false ->
     StmtSteps h loc (s_if e st sf) h loc (s_scope sf)
| step_while_true: forall h loc e body,
     ExprYields t_bool loc e v_true ->
     StmtSteps h loc (s_while e body)
               h loc (s_seq (s_scope body) (s_while e body))
| step_while_false: forall h loc e body,
     ExprYields t_bool loc e v_false ->
     StmtSteps h loc (s_while e body) h loc s_skip
| step_local: forall h loc id type e a,
     NatMap.find id loc = None ->
     ExprYields type loc e a ->
     StmtSteps h loc (s_local (mkvar type id) e) h (NatMap.add id (mkval type a) loc) s_skip
(* XXX
| step_getlock: ?
| step_putlock: ?
*)
.

End Statements.

(**************************************************************)
(* stacks *)

Section Stacks.

Inductive Stack: Type :=
| stack_empty: Stack
| stack_pending: forall (t : type), Locals -> var -> Stack -> Stack
.

Inductive CallSteps: Stack -> Locals -> stmt ->
                     Stack -> Locals -> stmt -> Prop :=
| call_steps: forall loc stk retid rt paramid pt body arg argval,
     ExprYields pt loc arg argval ->
     CallSteps stk loc (s_call (mkvar rt retid)
                               (mkproc rt (mkvar pt paramid) body)
                               arg)
               (stack_pending rt loc (mkvar rt retid) stk)
               (NatMap.add paramid (mkval pt argval) (NatMap.empty val))
               body
.

Inductive ReturnSteps: Stack -> Locals -> stmt ->
                        Stack -> Locals -> stmt -> Prop :=
| return_steps: forall loc loc' rt retid stk ret retval,
     ExprYields rt loc ret retval ->
     ReturnSteps (stack_pending rt loc' (mkvar rt retid) stk) loc
                                                              (s_return ret)
                 stk loc' (s_assign (mkvar rt retid) (e_value rt retval))
.

End Stacks.

(**************************************************************)
(* threads *)

Section Threads.

Inductive Thread: Type :=
| thread: Locals -> Stack -> stmt -> Thread
.

Inductive ThreadSteps: Heap -> Thread -> Heap -> Thread -> Prop :=
| thread_steps_stmt: forall h loc stk s h' loc' s',
     StmtSteps h loc s h' loc' s' ->
     ThreadSteps h (thread loc stk s) h' (thread loc' stk s')
| thread_steps_call_final: forall h loc stk s loc' stk' s',
     CallSteps stk loc s stk' loc' s' ->
     ThreadSteps h (thread loc stk s)
		 h (thread loc' stk' s')
| thread_steps_call_seq: forall h loc stk s s2 loc' stk' s',
     CallSteps stk loc s stk' loc' s' ->
     ThreadSteps h (thread loc stk (s_seq s s2))
		 h (thread loc' stk' (s_seq s' s2))
| thread_steps_return_final: forall h loc stk s loc' stk' s',
     ReturnSteps stk loc s stk' loc' s' ->
     ThreadSteps h (thread loc stk s)
		 h (thread loc' stk' s')
| thread_steps_return_seq: forall h loc stk s s2 loc' stk' s',
     ReturnSteps stk loc s stk' loc' s' ->
     ThreadSteps h (thread loc stk (s_seq s s2))
		 h (thread loc' stk' s')
.

(* this is its own thing because it needs a different signature *)
Inductive ThreadStepsStart: Thread -> Thread -> Thread -> Prop :=
| thread_steps_start: forall loc stk pt paramid body arg argval,
     ExprYields pt loc arg argval ->
     ThreadStepsStart
	(thread loc stk (s_start (mkproc t_unit (mkvar pt paramid) body) arg))
        (thread loc stk s_skip)
	(thread (NatMap.add paramid (mkval pt argval) (NatMap.empty val)) stack_empty body)
.

End Threads.

(**************************************************************)
(* machines *)

Section Machines.

Inductive Machine: Type :=
| machine: Heap -> list Thread -> Machine
.

Inductive MachineSteps: Machine -> Machine -> Prop :=
| machine_steps_plain: forall h t h' t' ts1 ts2,
     ThreadSteps h t h' t' ->
     MachineSteps (machine h (ts1 ++ [t] ++ ts2))
		  (machine h' (ts1 ++ [t'] ++ ts2))
| machine_steps_start: forall h t t1 t2 ts1 ts2,
     ThreadStepsStart t t1 t2 ->
     MachineSteps (machine h (ts1 ++ [t] ++ ts2))
		  (machine h (ts1 ++ [t1; t2] ++ ts2))
.

End Machines.


Require Import VST.floyd.proofauto.
Local Open Scope logic.
Require Import Coq.Lists.List. Import ListNotations.
Require Import sha.general_lemmas.

Require Import tweetnacl20140427.split_array_lemmas.
Require Import ZArith.
Require Import tweetnacl20140427.tweetNaclBase.
Require Import tweetnacl20140427.Salsa20.
Require Import tweetnacl20140427.verif_salsa_base.
Require Import tweetnacl20140427.tweetnaclVerifiableC.
Require Import tweetnacl20140427.Snuffle.
Require Import tweetnacl20140427.spec_salsa. Opaque Snuffle.Snuffle.
Require Import tweetnacl20140427.verif_crypto_stream_salsa20_xor.

Lemma crypto_stream_salsa20_tweet_ok: semax_body SalsaVarSpecs (*(crypto_stream_salsa20_xor_spec::*)SalsaFunSpecs
      f_crypto_stream_salsa20_tweet
      f_crypto_stream_salsa20_tweet_spec.
Proof.
start_function.
abbreviate_semax.
forward_call (c, k, nullval, nonce, d, Nonce, K, list_repeat (Z.to_nat (Int64.unsigned d)) Byte.zero, SV).
{ simpl; entailer!. }
apply Zlength_list_repeat. apply Int64.unsigned_range.

forward.
Qed.

(*The crypto_stream function*)
Lemma crypto_stream_xsalsa20_tweet_ok:
      semax_body SalsaVarSpecs SalsaFunSpecs
      f_crypto_stream_xsalsa20_tweet
      f_crypto_stream_xsalsa20_tweet_spec.
Proof.
start_function. unfold data_at_, field_at_. simpl.
unfold Sigma_vector.
forward_call (SV, k, nonce, v_s,
        default_val (tarray tuchar 32),
        ((Nonce, SIGMA), K)).
{ unfold CoreInSEP, SByte. cancel. }
Intros v.
unfold CoreInSEP, SByte, Sigma_vector. normalize.
assert_PROP (isptr nonce) as PN by entailer!.
assert (exists HSalsaRes, hSalsaOut v =
   match HSalsaRes with (q1, q2) =>
     SixteenByte2ValList q1 ++ SixteenByte2ValList q2
   end).
{ unfold hSalsaOut.
  exists ((littleendian_invert (Znth 0 v Int.zero),
           littleendian_invert (Znth 5 v Int.zero),
           littleendian_invert (Znth 10 v Int.zero),
           littleendian_invert (Znth 15 v Int.zero)),
          (littleendian_invert (Znth 6 v Int.zero),
           littleendian_invert (Znth 7 v Int.zero),
           littleendian_invert (Znth 8 v Int.zero),
           littleendian_invert (Znth 9 v Int.zero))).
  do 2 rewrite SixteenByte2ValList_char. repeat rewrite <- app_assoc. trivial. }
destruct H0 as [HSalsaRes HS]. rewrite HS.
forward_call (c, v_s, offset_val 16 nonce, d, Nonce2, HSalsaRes, SV).
{ unfold SByte, Sigma_vector, ThirtyTwoByte.
  destruct HSalsaRes as [q1 q2]. cancel.
  unfold data_at_. cancel. }
forward.
unfold ThirtyTwoByte. entailer.
 Exists HSalsaRes. entailer. cancel.
destruct HSalsaRes as [q1 q2]. cancel.
Qed.

(*The crypto_stream_xor function*)
Lemma crypto_stream_xsalsa20_tweet_xor_ok:
      semax_body SalsaVarSpecs SalsaFunSpecs
      f_crypto_stream_xsalsa20_tweet_xor
      f_crypto_stream_xsalsa20_tweet_xor_spec.
Proof.
start_function.
rename v_s into s. rename H into mLen. unfold data_at_, field_at_. simpl.
unfold Sigma_vector.
forward_call (SV, k, nonce, s,
        default_val (tarray tuchar 32),
        ((Nonce, SIGMA), K)).
{ unfold CoreInSEP, SByte. cancel. }
Intros v.
unfold CoreInSEP, SByte, Sigma_vector. normalize.
assert_PROP (isptr nonce) as PN by entailer!.
assert (exists HSalsaRes, hSalsaOut v =
   match HSalsaRes with (q1, q2) =>
     SixteenByte2ValList q1 ++ SixteenByte2ValList q2
   end).
{ exists ((littleendian_invert (Znth 0 v Int.zero),
           littleendian_invert (Znth 5 v Int.zero),
           littleendian_invert (Znth 10 v Int.zero),
           littleendian_invert (Znth 15 v Int.zero)),
          (littleendian_invert (Znth 6 v Int.zero),
           littleendian_invert (Znth 7 v Int.zero),
           littleendian_invert (Znth 8 v Int.zero),
           littleendian_invert (Znth 9 v Int.zero))).
  do 2 rewrite SixteenByte2ValList_char. repeat rewrite <- app_assoc. trivial. }
destruct H0 as [[q1 q2] HS]. rewrite HS.
forward_call (c, s, m, offset_val 16 nonce, d, Nonce2, (q1,q2), mCont, SV).
{ unfold SByte, Sigma_vector, data_at_. unfold ThirtyTwoByte at 2. cancel. }
forward.
Exists (q1, q2). unfold ThirtyTwoByte. entailer!.
Qed.


Require Import Program.Basics Lia.
From hahn Require Import Hahn.
From PromisingLib Require Import Basic Language.
From imm Require Import Events Execution TraversalConfig Traversal
     Prog ProgToExecution ProgToExecutionProperties imm_s imm_s_hb
     SimState
     CombRelations SimTraversal.
Require Import AuxRel.
Require Import AuxDef.
Require Import EventStructure.
Require Import Consistency.
Require Import BasicStep.
Require Import EventToAction.
Require Import LblStep.
Require Import ProgES.

Set Implicit Arguments.
Local Open Scope program_scope.

Section SimRelCont.
  Variable prog : Prog.t.
  Variable S : ES.t.
  Variable sc : relation actid.

  Notation "'SE'" := S.(ES.acts_set).
  Notation "'SEinit'" := S.(ES.acts_init_set).
  Notation "'SEninit'" := S.(ES.acts_ninit_set).

  Notation "'Stid'" := (S.(ES.tid)).
  Notation "'Slab'" := (S.(ES.lab)).
  Notation "'Sloc'" := (loc S.(ES.lab)).

  Notation "'K'" := (ES.cont_set S) (at level 1).

  Notation "'STid' t" := (fun x => Stid x = t) (at level 1).

  Notation "'SR'" := (fun a => is_true (is_r Slab a)).
  Notation "'SW'" := (fun a => is_true (is_w Slab a)).
  Notation "'SF'" := (fun a => is_true (is_f Slab a)).
  Notation "'SRel'" := (fun a => is_true (is_rel Slab a)).
  Notation "'SAcq'" := (fun a => is_true (is_acq Slab a)).

  Notation "'Ssb'" := (S.(ES.sb)).
  Notation "'Scf'" := (S.(ES.cf)).
  Notation "'Srmw'" := (S.(ES.rmw)).

  Notation "'thread_syntax' t"  :=
    (Language.syntax (thread_lts t)) (at level 10, only parsing).

  Notation "'thread_st' t" :=
    (Language.state (thread_lts t)) (at level 10, only parsing).

  Notation "'thread_init_st' t" :=
    (Language.init (thread_lts t)) (at level 10, only parsing).

  Notation "'thread_cont_st' t" :=
    (fun st => existT _ (thread_lts t) st) (at level 10, only parsing).

  Record simrel_cont :=
    { contlang : forall k lang (state : lang.(Language.state))
                        (INK : K (k, existT _ lang state)),
        lang = thread_lts (ES.cont_thread S k);

      contwf : forall k (state : thread_st (ES.cont_thread S k))
                      (INK : K (k, thread_cont_st (ES.cont_thread S k) state)),
          wf_thread_state (ES.cont_thread S k) state;

      contstable : forall k (state : thread_st (ES.cont_thread S k))
                          (INK : K (k, thread_cont_st (ES.cont_thread S k) state)),
          stable_state state;

      contrun : forall thread (lprog : thread_syntax thread)
                       (INPROG : IdentMap.find thread prog = Some lprog),
          exists (state : thread_st thread),
            ⟪ INK : K (CInit thread, thread_cont_st thread state) ⟫ /\
            ⟪ INITST : (istep thread [])＊ (thread_init_st thread lprog) state⟫;

      contreach :
        forall k (state : thread_st (ES.cont_thread S k))
               (lprog : thread_syntax (ES.cont_thread S k))
               (INPROG : IdentMap.find (ES.cont_thread S k) prog =
                         Some lprog)
               (INK : K (k, thread_cont_st (ES.cont_thread S k) state)),
          (step (ES.cont_thread S k))＊
            (thread_init_st (ES.cont_thread S k) lprog)
            state;

      continit : forall thread (state : thread_st thread)
                        (INKi : K (CInit thread, thread_cont_st thread state)),
          state.(eindex) = 0;

      contseqn : forall e (state : thread_st (Stid e))
                        (INKe : K (CEvent e, thread_cont_st (Stid e) state)),
          state.(eindex) = 1 + ES.seqn S e;

      (* contpc : forall e (state : thread_st (Stid e)) *)
      (*                 (XE : X e) *)
      (*                 (PC : pc (Stid e) (e2a S e)) *)
      (*                 (INK : K S (CEvent e, thread_cont_st (Stid e) state)), *)
      (*     @sim_state G sim_normal C (Stid e) state; *)

      (* continitstate : *)
      (*   forall thread (state : thread_st thread) *)
      (*          (CEMP : C ∩₁ GTid thread ⊆₁ ∅) *)
      (*          (INK : K S (CInit thread, thread_cont_st thread state)), *)
      (*     @sim_state G sim_normal C thread state; *)

    }.

  Section SimRelContProps.

    Variable WF : ES.Wf S.
    Variable SRK : simrel_cont.

    Lemma simrel_cont_adjacent_inK' k k' e e'
          (st : thread_st (ES.cont_thread S k))
          (KK : K (k, existT _ (thread_lts (ES.cont_thread S k)) st))
          (ADJ : ES.cont_adjacent S k k' e e') :
      exists st', K (k', existT _ (thread_lts (ES.cont_thread S k)) st').
    Proof.
      (* a piece of dark magic *)
      edestruct ES.cont_adjacent_inK'
        as [c KK'']; eauto.
      assert
        (exists st', c = existT _ (thread_lts (ES.cont_thread S k)) st')
        as [st' EQc]; [|subst c; eauto].
      arewrite (thread_lts (ES.cont_thread S k) = projT1 c).
      2 : exists (projT2 c); eapply sigT_eta.
      cdes ADJ.
      rewrite kEQTID.
      symmetry.
      eapply contlang; eauto.
      erewrite <- sigT_eta.
      eapply KK''.
    Qed.

  End SimRelContProps.

End SimRelCont.

Section SimRelContLemmas.
  Variable prog : Prog.t.
  Variable S : ES.t.
  Variable WF : ES.Wf S.
  Variable SRK : simrel_cont prog S.

  Notation "'SE' S" := S.(ES.acts_set) (at level 10).
  Notation "'SEinit' S" := S.(ES.acts_init_set) (at level 10).
  Notation "'SEninit' S" := S.(ES.acts_ninit_set) (at level 10).
  Notation "'Stid' S" := (S.(ES.tid)) (at level 10).
  Notation "'Slab' S" := S.(ES.lab) (at level 10).
  Notation "'Sloc' S" := (loc S.(ES.lab)) (at level 10).

  Notation "'K' S" := (S.(ES.cont_set)) (at level 10).

  Notation "'Ssb' S" := S.(ES.sb) (at level 10).
  Notation "'Srmw' S" := S.(ES.rmw) (at level 10).

  Notation "'thread_syntax' t"  :=
    (Language.syntax (thread_lts t)) (at level 10, only parsing).

  Notation "'thread_st' t" :=
    (Language.state (thread_lts t)) (at level 10, only parsing).

  Notation "'thread_init_st' t" :=
    (Language.init (thread_lts t)) (at level 10, only parsing).

  Notation "'thread_cont_st' t" :=
    (fun st => existT _ (thread_lts t) st) (at level 10, only parsing).

  Notation "'cont_lang'" :=
    (fun S k => thread_lts (ES.cont_thread S k)) (at level 10, only parsing).

  Notation "'STid'" := (fun S t x => ES.tid S x = t) (at level 1).

  Lemma kstate_instrs k (state : thread_st (ES.cont_thread S k))
        (lprog : thread_syntax (ES.cont_thread S k))
        (INPROG : IdentMap.find (ES.cont_thread S k) prog = Some lprog)
        (INK : K S (k, thread_cont_st (ES.cont_thread S k) state)) :
    lprog = instrs state.
  Proof.
    eapply contreach in INK; eauto.
    apply steps_same_instrs in INK. simpls.
  Qed.

  Lemma basic_step_simrel_cont k k' e e' S'
        (st st' : thread_st (ES.cont_thread S k))
        (BSTEP_ : basic_step_ (cont_lang S k) k k' st st' e e' S S'):
        (* (STCOV : C ∩₁ GTid_ (ES.cont_thread S k) ⊆₁ acts_set st.(ProgToExecution.G)) :  *)
    simrel_cont prog S'.
  Proof.
    cdes BSTEP_.
    assert (basic_step e e' S S') as BSTEP.
    { econstructor; eauto. }

    assert (Stid S' (opt_ext e e') = ES.cont_thread S k) as TIDee.
    { edestruct e'; simpl;
        [eapply basic_step_tid_e' | eapply basic_step_tid_e];
        eauto. }

    assert (st'.(eindex) = 1 + ES.seqn S' (opt_ext e e')) as ST_IDX.
    { edestruct ilbl_step_cases as [l [l' HH]]; eauto.
      { eapply contwf; eauto. }
      { apply STEP. }
      edestruct HH as [EE _].
      apply opt_to_list_app_singl in EE.
      destruct EE as [eqLBL eqLBL'].
      edestruct e'; simpl; unfold opt_ext.
      { destruct HH as [_ [HH | HH]].
        { destruct HH as [_ [_ [_ [LBL _]]]].
          subst l'. rewrite LBL in LABEL'. exfalso. auto. }
        destruct HH as [IDX _].
        erewrite IDX. simpl.
        erewrite basic_step_seqn_e'; eauto.
        arewrite (eindex st = ES.seqn S' e); [|lia].
        edestruct k.
        { erewrite continit; eauto.
          erewrite basic_step_seqn_kinit; eauto. }
        erewrite contseqn; eauto.
        erewrite <- basic_step_seqn_kevent; eauto. }
      destruct HH as [_ [HH | HH]].
      2: by desf.
      destruct HH as [IDX _].
      erewrite IDX. simpl.
      edestruct k.
      { erewrite continit; eauto.
        erewrite basic_step_seqn_kinit; eauto. }
      erewrite contseqn; eauto.
      erewrite <- basic_step_seqn_kevent; eauto. }

    split.

    (* contlang *)
    { intros kk lang st'' INK.
      eapply basic_step_cont_set in INK; eauto.
      unfold set_union in INK. destruct INK as [HA | HB].
      { erewrite basic_step_cont_thread; eauto.
          by eapply SRK in HA. }
      inversion HB.
      rewrite <- KCE.
      erewrite basic_step_cont_thread' with (k' := k').
      all : eauto. }

    (* contwf *)
    { intros kk st'' KK.
      eapply basic_step_cont_set in KK; eauto.
      unfold set_union in KK.
      destruct KK as [KK | KK].
      { erewrite basic_step_cont_thread; eauto.
        apply SRK.
        erewrite <- basic_step_cont_thread; eauto. }
      assert (kk = CEvent (opt_ext e e')) as kkEQ.
      { by inversion KK. }
      rewrite <- kkEQ in *.
      assert (ES.cont_thread S' kk = (ES.cont_thread S k)) as Hkk.
      { by rewrite kkEQ. }
      rewrite Hkk in *.
      inversion KK as [HH].
      apply inj_pair2 in HH.
      rewrite <- HH.
      eapply wf_thread_state_steps.
      { eapply SRK; eauto. }
      eapply lbl_steps_in_steps.
      do 2 econstructor.
      eapply STEP. }

    (* contstable *)
    { intros kk st'' KK.
      eapply basic_step_cont_set in KK; eauto.
      unfold set_union in KK.
      destruct KK as [KK | KK].
      { eapply SRK.
        erewrite <- basic_step_cont_thread; eauto. }
      assert (kk = CEvent (opt_ext e e')) as kkEQ.
      { by inversion KK. }
      rewrite <- kkEQ in *.
      assert (ES.cont_thread S' kk = (ES.cont_thread S k)) as Hkk.
      { by rewrite kkEQ. }
      rewrite Hkk in *.
      inversion KK as [HH].
      apply inj_pair2 in HH.
      rewrite <- HH.
      simpls.
      unfold ilbl_step in STEP.
      apply seqA in STEP.
      apply seq_eqv_r in STEP.
      desf. }

    (* contrun *)
    { intros thread lprog INP.
      edestruct SRK.(contrun) as [st'' [Kinit ISTEP]]; eauto.
      eexists; split; eauto.
      eapply basic_step_cont_set; eauto.
      left. eauto. }

    (* contreach *)
    { ins. red in INK. rewrite CONT' in INK.
      apply in_inv in INK. destruct INK as [INK|INK].
      2: { assert (ES.cont_thread S' k0 = ES.cont_thread S k0) as HH.
           { eapply basic_step_cont_thread; eauto. }
           rewrite HH in *.
           eapply contreach; eauto. }
      assert (k0 = k') as YY by inv INK; rewrite YY in *.
      assert (ES.cont_thread S' k' = ES.cont_thread S k) as BB.
      { eapply basic_step_cont_thread'; eauto. }
      rewrite BB in *.
      assert (state = st'); subst.
      { apply pair_inj in INK. destruct INK as [AA INK]; subst.
        inv INK. }
      apply rt_rt. exists st. split.
      { eapply contreach; eauto. }
      apply inclusion_t_rt.
      eapply ilbl_step_in_steps; eauto. }

    (* contseqn *)
    { intros thread st'' KK.
      eapply basic_step_cont_set in KK; eauto.
      unfold set_union in KK.
      destruct KK as [KK | KK].
      { by eapply SRK. }
      exfalso. inversion KK. }
    intros x st'' KK.
    eapply basic_step_cont_set in KK; eauto.
    unfold set_union in KK.
    destruct KK as [KK | KK].
    { assert (SE S x) as SEx.
      { eapply ES.K_inEninit; eauto. }
      erewrite basic_step_seqn_eq_dom; eauto.
      eapply SRK. erewrite <- basic_step_tid_eq_dom; eauto. }
    assert (x = opt_ext e e') as xEQ.
    { by inversion KK. }
    rewrite xEQ, TIDee in KK.
    inversion KK as [HST].
    apply inj_pair2 in HST.
    congruence.
  Qed.

  Lemma basic_step_cont_icf_dom_same_lab_u2v k k' e e' S'
        (st st' : thread_st (ES.cont_thread S k))
        (BSTEP_ : basic_step_ (cont_lang S k) k k' st st' e e' S S') :
    Slab S □₁ ES.cont_icf_dom S k ⊆₁ same_label_u2v (Slab S' e).
  Proof.
    cdes BSTEP_.
    arewrite (Slab S' e = lbl).
    { rewrite LAB'.
      rewrite updo_opt, upds; auto.
      destruct e' as [e'|]; auto.
      unfold opt_ext in *. subst.
      unfolder. lia. }
    intros l [a [kICFx EQl]].
    edestruct ES.cont_icf_dom_cont_adjacent
      as [k'' [a' ADJ]]; eauto.
    edestruct simrel_cont_adjacent_inK'
      as [st'' KK'']; eauto.
    edestruct ES.K_adj
      with (k := k) (k' := k'') (st' := st'')
      as [ll [ll' [EQll [EQll' STEP']]]]; eauto.
    red in EQll, EQll', STEP'.
    rewrite <- EQl.
    rewrite <- EQll.
    eapply same_label_u2v_ilbl_step.
    { eapply STEP. }
    apply STEP'.
  Qed.

  Lemma basic_step_cont_icf_dom_nR_same_lab k k' e e' S'
        (st st' : thread_st (ES.cont_thread S k))
        (BSTEP_ : basic_step_ (cont_lang S k) k k' st st' e e' S S') :
    Slab S □₁ (ES.cont_icf_dom S k ∩₁ set_compl (is_r (Slab S))) ⊆₁ eq (Slab S' e).
  Proof.
    cdes BSTEP_.
    arewrite (Slab S' e = lbl).
    { rewrite LAB'.
      rewrite updo_opt, upds; auto.
      destruct e' as [e'|]; auto.
      unfold opt_ext in *. subst.
      unfolder. lia. }
    intros l [a [[kICFx nR] EQl]].
    edestruct ES.cont_icf_dom_cont_adjacent
      as [k'' [a' ADJ]]; eauto.
    edestruct simrel_cont_adjacent_inK'
      as [st'' KK'']; eauto.
    edestruct ES.K_adj
      with (k := k) (k' := k'') (st' := st'')
      as [ll [ll' [EQll [EQll' STEP']]]]; eauto.
    red in EQll, EQll', STEP'.
    rewrite <- EQl.
    rewrite <- EQll.
    symmetry.
    eapply same_label_nR_ilbl_step.
    { eapply STEP'. }
    { apply STEP. }
    basic_solver.
  Qed.

End SimRelContLemmas.


Require Import AutoSep Wrap StringOps Malloc ArrayOps Buffers Bags.
Require Import RelDb.

Set Implicit Arguments.

Local Hint Extern 1 (@eq W _ _) => words.

(** * Iterating over matching rows of a table *)

Opaque mult.
Local Infix ";;" := SimpleSeq : SP_scope.

Section Condition.
  Variable A : Type.
  Variable invPre : A -> vals -> HProp.
  Variable invPost : A -> vals -> W -> HProp.

  Variable tptr : W.
  Variable sch : schema.

  (* Store a pointer to the current row data in this variable.
   * in these variables. *)
  Variables data : string.

  (* Test to use in filtering rows *)
  Variable cond : condition.

  (* One field test, storing Boolean result in "matched" *)
  Definition compileEquality (e : equality) : chunk :=
    match resolve sch (fst e) with
      | None => Fail
      | Some offset =>
        "tmp" <- data;;
        "ibuf" <-* "tmp";;
        "ilen" <-* "tmp" + 4;;

        Assert [Al bs, Al a : A, Al rcols, Al rbs,
          PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |]
            * [| inputOk V (exps cond) |] * invPre a V
            * (V data ==*> V "ibuf", V "ilen") * array (posl rcols) (V data ^+ $8)
            * array (lenl rcols) (V data ^+ $8 ^+ $(length sch * 4)) * array8 rbs (V "ibuf")
            * [| length rbs = wordToNat (V "ilen") |] * [| length rcols = length sch |]
            * [| inBounds (V "ilen") rcols |] * [| V data <> 0 |]
            * [| freeable (V data) (2 + length sch + length sch) |]
            * [| V "ibuf" <> 0 |] * [| freeable8 (V "ibuf") (length rbs) |]
            * [| natToW offset < natToW (length (posl rcols)) |]%word
          POST[R] array8 bs (V "buf") * invPost a V R];;

        "tmp" <- data + 8;;
        "ipos" <-* "tmp" + (4 * offset)%nat;;

        Assert [Al bs, Al a : A, Al rcols, Al rbs,
          PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |]
            * [| inputOk V (exps cond) |] * invPre a V
            * (V data ==*> V "ibuf", V "ilen") * array (posl rcols) (V data ^+ $8)
            * array (lenl rcols) (V data ^+ $8 ^+ $(length sch * 4)) * array8 rbs (V "ibuf")
            * [| length rbs = wordToNat (V "ilen") |] * [| length rcols = length sch |]
            * [| inBounds (V "ilen") rcols |] * [| V data <> 0 |]
            * [| freeable (V data) (2 + length sch + length sch) |]
            * [| V "ibuf" <> 0 |] * [| freeable8 (V "ibuf") (length rbs) |]
            * [| V "ipos" = Array.selN (posl rcols) offset |]
            * [| natToW offset < natToW (length (lenl rcols)) |]%word
          POST[R] array8 bs (V "buf") * invPost a V R];;

        "tmp" <- data + 8;;
        "tmp" <- "tmp" + (length sch * 4)%nat;;
        "tmp" <-* "tmp" + (4 * offset)%nat;;

        Assert [Al bs, Al a : A, Al rcols, Al rbs,
          PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |]
            * [| inputOk V (exps cond) |] * invPre a V
            * (V data ==*> V "ibuf", V "ilen") * array (posl rcols) (V data ^+ $8)
            * array (lenl rcols) (V data ^+ $8 ^+ $(length sch * 4)) * array8 rbs (V "ibuf")
            * [| length rbs = wordToNat (V "ilen") |] * [| length rcols = length sch |]
            * [| inBounds (V "ilen") rcols |] * [| V data <> 0 |]
            * [| freeable (V data) (2 + length sch + length sch) |]
            * [| V "ibuf" <> 0 |] * [| freeable8 (V "ibuf") (length rbs) |]
            * [| V "ipos" = Array.selN (posl rcols) offset |]
            * [| V "tmp" = Array.selN (lenl rcols) offset |]
          POST[R] array8 bs (V "buf") * invPost a V R];;

        match snd e with
          | Const s =>
            If ("tmp" <> String.length s) {
              (* Field value has wrong length to match. *)
              "matched" <- 0
            } else {
              StringEq "ibuf" "ilen" "ipos" "matched" s
              (fun (a_bs : A * list B) V => array8 (snd a_bs) (V "buf")
                * [| length (snd a_bs) = wordToNat (V "len") |]
                * [| inputOk V (exps cond) |] * invPre (fst a_bs) V
                * Ex rcols,
                  (V data ==*> V "ibuf", V "ilen") * array (posl rcols) (V data ^+ $8)
                  * array (lenl rcols) (V data ^+ $8 ^+ $(length sch * 4))
                  * [| length rcols = length sch |]
                  * [| inBounds (V "ilen") rcols |] * [| V data <> 0 |]
                  * [| freeable (V data) (2 + length sch + length sch) |]
                  * [| V "ibuf" <> 0 |] * [| freeable8 (V "ibuf") (wordToNat (V "ilen")) |]
                  * [| V "ipos" = Array.selN (posl rcols) offset |])%Sep
              (fun _ a_bs V R => array8 (snd a_bs) (V "buf") * invPost (fst a_bs) V R)%Sep
            }
          | Input pos len =>
            If ("tmp" <> len) {
              "matched" <- 0
            } else {
              "matched" <-- Call "array8"!"equal"("ibuf", "ipos", "buf", pos, len)
              [Al bs, Al a : A,
                PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |]
                  * [| inputOk V (exps cond) |] * row sch (V data) * invPre a V
                POST[R] array8 bs (V "buf") * invPost a V R]
            }
        end
    end%SP.

  Variable mn : string.
  Variable im : LabelMap.t assert.
  Variable H : importsGlobal im.
  Variable ns : list string.
  Variable res : nat.

  Definition eqinv' := Al bs, Al a : A,
    PRE[V] array8 bs (V "buf") * [| length bs = wordToNat (V "len") |]
      * [| inputOk V (exps cond) |]
      * row sch (V data) * invPre a V
    POST[R] array8 bs (V "buf") * invPost a V R.

  Definition eqinv := eqinv' true (fun w => w).

  Hypothesis not_rp : ~In "rp" ns.
  Hypothesis included : incl baseVars ns.
  Hypothesis reserved : (res >= 10)%nat.
  Hypothesis wellFormed : wfEqualities ns sch cond.

  Hypothesis weakenPre : (forall a V V', (forall x, x <> "ibuf" -> x <> "ilen" -> x <> "tmp"
    -> x <> "ipos" -> x <> "overflowed" -> x <> "matched" -> sel V x = sel V' x)
  -> invPre a V ===> invPre a V').

  Hypothesis weakenPost : (forall a V V' R, (forall x, x <> "ibuf" -> x <> "ilen" -> x <> "tmp"
    -> x <> "ipos" -> x <> "overflowed" -> x <> "matched" -> sel V x = sel V' x)
  -> invPost a V R = invPost a V' R).

  Lemma resolve_ok : forall e s,
    wfEquality ns s e
    -> exists offset, resolve s (fst e) = Some offset
      /\ (offset < length s)%nat.
    unfold wfEquality; induction s; simpl; intuition subst;
      match goal with
        | [ |- context[if ?E then _ else _] ] => destruct E
      end; intuition eauto.
    destruct H1; intuition idtac.
    rewrite H3; eauto.
  Qed.

  Hypothesis matched_data : "matched" <> data.

  Lemma compileEquality_post : forall e pre,
    wfEquality ns sch e
    -> (forall specs st,
      interp specs (pre st)
      -> interp specs (eqinv ns res st))
    -> forall specs st,
      interp specs (Postcondition (toCmd (compileEquality e) mn (im := im) H ns res pre) st)
      -> interp specs (eqinv ns res st).
    unfold compileEquality; intros.
    match goal with
      | [ H : _ |- _ ] => destruct (resolve_ok H); intuition idtac; destruct H
    end.
    match goal with
      | [ H : resolve _ _ = _ |- _ ] => rewrite H in *
    end.
    destruct e as [ ? [ ] ]; simpl in *; intuition idtac.

    v.
    v.
  Qed.

  Hypothesis equal : "array8"!"equal" ~~ im ~~> ArrayOps.equalS.

  Hypothesis data_rp : data <> "rp".
  Hypothesis data_ibuf : data <> "ibuf".
  Hypothesis data_ipos : data <> "ipos".
  Hypothesis data_ilen : data <> "ilen".
  Hypothesis data_tmp : data <> "tmp".
  Hypothesis data_ns : In data ns.

  Hypothesis goodSize_sch : goodSize (length sch).

  Lemma length_posl : forall ls, length (posl ls) = length ls.
    clear; induction ls; simpl; intuition.
  Qed.

  Lemma length_lenl : forall ls, length (lenl ls) = length ls.
    clear; induction ls; simpl; intuition.
  Qed.

  Lemma length_match : forall x (ls : list (W * W)),
    (x < length sch)%nat
    -> length ls = length sch
    -> natToW x < natToW (Datatypes.length ls).
    generalize goodSize_sch; clear; intros.
    pre_nomega.
    rewrite wordToNat_natToWord_idempotent.
    rewrite wordToNat_natToWord_idempotent.
    congruence.
    rewrite H0; assumption.
    change (goodSize x); eapply goodSize_weaken; eauto.
  Qed.

  Lemma length_match_posl : forall x ls,
    (x < length sch)%nat
    -> length ls = length sch
    -> natToW x < natToW (Datatypes.length (posl ls)).
    intros; rewrite length_posl; auto using length_match.
  Qed.

  Lemma length_match_lenl : forall x ls,
    (x < length sch)%nat
    -> length ls = length sch
    -> natToW x < natToW (Datatypes.length (lenl ls)).
    intros; rewrite length_lenl; auto using length_match.
  Qed.

  Hint Immediate length_match_posl length_match_lenl.

  Lemma selN_col : forall x ls,
    (x < length sch)%nat
    -> Array.sel ls (natToW x) = selN ls x.
    generalize goodSize_sch; clear; unfold Array.sel; intros; f_equal.
    apply wordToNat_natToWord_idempotent.
    change (goodSize x).
    eapply goodSize_weaken; eauto.
  Qed.

  Hint Immediate selN_col.

  Lemma inBounds_selN' : forall len cols,
    inBounds len cols
    -> forall col, (col < length cols)%nat
      -> (wordToNat (selN (posl cols) col) + wordToNat (selN (lenl cols) col) <= wordToNat len)%nat.
    clear; induction cols; inversion 1; simpl; intuition; destruct col; intuition.
  Qed.

  Lemma inBounds_selN : forall len cols,
    inBounds len cols
    -> forall col a b c, a = selN (posl cols) col
      -> b = selN (lenl cols) col
      -> c = wordToNat len
      -> (col < length cols)%nat
      -> (wordToNat a + wordToNat b <= c)%nat.
    intros; subst; eauto using inBounds_selN'.
  Qed.

  Hint Extern 1 (_ + _ <= _)%nat =>
    eapply inBounds_selN; try eassumption; (cbv beta; congruence).

  Lemma weakened_bound : forall pos cols x len,
    inBounds len cols
    -> pos = selN (posl cols) x
    -> (x < length cols)%nat
    -> pos <= len.
    clear; intros; subst.
    eapply inBounds_selN in H; try (reflexivity || eassumption).
    nomega.
  Qed.

  Hint Extern 1 (_ <= _) => eapply weakened_bound; try eassumption; (cbv beta; congruence).

  Hint Resolve use_inputOk.

  Lemma In_exps : forall s e c,
    In (s, e) c
    -> In e (exps c).
    clear; induction c; simpl; intuition (subst; auto).
  Qed.

  Hint Immediate In_exps.

  Lemma compileEquality_vcs : forall e pre,
    wfEquality ns sch e
    -> In e cond
    -> (forall specs st,
      interp specs (pre st)
      -> interp specs (eqinv ns res st))
    -> vcs (VerifCond (toCmd (compileEquality e) mn (im := im) H ns res pre)).
      unfold compileEquality; intros.
      match goal with
        | [ H : _ |- _ ] => destruct (resolve_ok H); intuition idtac; destruct H
      end.
      match goal with
        | [ H : resolve _ _ = _ |- _ ] => rewrite H in *
      end.
      wrap0.

      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.

      destruct e as [ ? [ ] ]; simpl in *; intuition idtac.

      repeat match goal with
               | [ |- vcs _ ] => constructor
             end; intros.

      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.
      v.

      repeat match goal with
               | [ |- vcs _ ] => constructor
             end; intros.

      (* Something bizarre is happening here, with [destruct] not clearing a hypothesis
       * within [propxFo]. *)
      apply simplify_fwd in H25.
      repeat match goal with
               | [ H : simplify _ (Ex x, _) _ |- _ ] => destruct H
             end.
      apply simplify_bwd in H25.
      v.

      v.
      v.
      v.
      v.
  Qed.

  Fixpoint compileEqualities (es : condition) : chunk :=
    match es with
      | nil => "matched" <- 1
      | e :: es' =>
        compileEquality e;;
        If ("matched" = 0) {
          Skip
        } else {
          compileEqualities es'
        }
    end%SP.

  Lemma wfEqualities_inv1 : forall ns sch e es,
    wfEqualities ns sch (e :: es)
    -> wfEquality ns sch e.
    inversion 1; auto.
  Qed.

  Lemma wfEqualities_inv2 : forall ns sch e es,
    wfEqualities ns sch (e :: es)
    -> wfEqualities ns sch es.
    inversion 1; auto.
  Qed.

  Hint Immediate wfEqualities_inv1 wfEqualities_inv2.

  Lemma compileEqualities_post : forall es pre,
    wfEqualities ns sch es
    -> (forall specs st,
      interp specs (pre st)
      -> interp specs (eqinv ns res st))
    -> forall specs st,
      interp specs (Postcondition (toCmd (compileEqualities es) mn (im := im) H ns res pre) st)
      -> interp specs (eqinv ns res st).
    induction es; simpl; intuition idtac;
      (pre;
        repeat (match goal with
                  | [ H : interp _ (Postcondition (toCmd (compileEquality _) _ _ _ _ _) _) |- _ ] =>
                    apply compileEquality_post in H
                  | [ IH : forall pre : _ -> _, _, H : interp _ (Postcondition _ _) |- _ ] =>
                    apply IH in H
                end; eauto; pre); t).
  Qed.

  Lemma compileEqualities_vcs : forall es pre,
    wfEqualities ns sch es
    -> incl es cond
    -> (forall specs st,
      interp specs (pre st)
      -> interp specs (eqinv ns res st))
    -> vcs (VerifCond (toCmd (compileEqualities es) mn (im := im) H ns res pre)).
    induction es; intros; try match goal with
                                | [ H : incl _ cond |- _ ] => apply incl_peel in H
                              end; wrap0;
    (repeat (match goal with
               | _ => apply compileEquality_vcs
               | [ H : interp _ (Postcondition (toCmd (compileEquality _) _ _ _ _ _) _) |- _ ] =>
                 apply compileEquality_post in H
               | [ IH : forall pre : _ -> _, _ |- vcs _ ] =>
                 apply IH
             end; eauto; pre); t).
  Qed.
End Condition.