From iris.proofmode Require Import proofmode.
From iris.algebra Require Import vector list.
From lrust.typing Require Export type.
From lrust.typing Require Import own programs cont.
From iris.prelude Require Import options.

Section fn.
  Context `{!typeGS Σ} {A : Type} {n : nat}.

  Record fn_params := FP { fp_E : lft → elctx; fp_tys : vec type n; fp_ty : type }.

  Definition FP_wf E (tys : vec type n) `{!ListTyWf tys} ty `{!TyWf ty} :=
    FP (λ ϝ, E ϝ ++ tyl_wf_E tys ++ tyl_outlives_E tys ϝ ++
                    ty_wf_E ty ++ ty_outlives_E ty ϝ)
       tys ty.

  (* The other alternative for defining the fn type would be to state
     that the value applied to its parameters is a typed body whose type
     is the return type.
     That would be slightly simpler, but, unfortunately, we are no longer
     able to prove that this is contractive. *)
  Program Definition fn (fp : A → fn_params) : type :=
    {| st_own tid vl := tc_opaque (∃ fb kb xb e H,
         ⌜vl = [@RecV fb (kb::xb) e H]⌝ ∗ ⌜length xb = n⌝ ∗
         ▷ ∀ (x : A) (ϝ : lft) (k : val) (xl : vec val (length xb)),
            □ typed_body ((fp x).(fp_E) ϝ) [ϝ ⊑ₗ []]
                         [k◁cont([ϝ ⊑ₗ []], λ v : vec _ 1, [(v!!!0%fin:val) ◁ box (fp x).(fp_ty)])]
                         (zip_with (TCtx_hasty ∘ of_val) xl
                                   (box <$> (vec_to_list (fp x).(fp_tys))))
                         (subst_v (fb::kb::xb) (RecV fb (kb::xb) e:::k:::xl) e))%I |}.
  Next Obligation.
    iIntros (fp tid vl) "H". iDestruct "H" as (fb kb xb e ?) "[% _]". by subst.
  Qed.
  Next Obligation.
    unfold tc_opaque. apply _.
  Qed.

  (* FIXME : This definition is less restrictive than the one used in
     Rust. In Rust, the type of parameters are taken into account for
     well-formedness, and all the liftime constrains relating a
     generalized liftime are ignored. For simplicity, we ignore all of
     them, but this is not very faithful. *)
  Global Instance fn_wf fp : TyWf (fn fp) :=
    { ty_lfts := []; ty_wf_E := [] }.

  Global Instance fn_send fp : Send (fn fp).
  Proof. iIntros (tid1 tid2 vl). done. Qed.

  Definition fn_params_rel (ty_rel : relation type) : relation fn_params :=
    λ fp1 fp2,
      Forall2 ty_rel fp2.(fp_tys) fp1.(fp_tys) ∧ ty_rel fp1.(fp_ty) fp2.(fp_ty) ∧
      pointwise_relation lft eq fp1.(fp_E) fp2.(fp_E).

  Global Instance fp_tys_proper R :
    Proper (flip (fn_params_rel R) ==> (Forall2 R : relation (vec _ _))) fp_tys.
  Proof. intros ?? HR. apply HR. Qed.
  Global Instance fp_tys_proper_flip R :
    Proper (fn_params_rel R ==> flip (Forall2 R : relation (vec _ _))) fp_tys.
  Proof. intros ?? HR. apply HR. Qed.

  Global Instance fp_ty_proper R :
    Proper (fn_params_rel R ==> R) fp_ty.
  Proof. intros ?? HR. apply HR. Qed.

  Global Instance fp_E_proper R :
    Proper (fn_params_rel R ==> eq ==> eq) fp_E.
  Proof. intros ?? HR ??->. apply HR. Qed.

  Global Instance FP_proper R :
    Proper (pointwise_relation lft eq ==>
            flip (Forall2 R : relation (vec _ _)) ==> R ==>
            fn_params_rel R) FP.
  Proof. by split; [|split]. Qed.

  Global Instance fn_type_contractive n' :
    Proper (pointwise_relation A (fn_params_rel (type_dist2_later n')) ==>
            type_dist2 n') fn.
  Proof.
    intros fp1 fp2 Hfp. apply ty_of_st_type_ne. destruct n'; first done.
    constructor; unfold ty_own; simpl.
    (* TODO: 'f_equiv' is slow here because reflexivity is slow. *)
    (* The clean way to do this would be to have a metric on type contexts. Oh well. *)
    intros tid vl. unfold typed_body.
    do 12 f_equiv. f_contractive.
    do 18 ((eapply fp_E_proper; try reflexivity) || exact: Hfp || f_equiv).
    - rewrite !cctx_interp_singleton /=. do 5 f_equiv.
      rewrite !tctx_interp_singleton /tctx_elt_interp /=.
      do 5 f_equiv. apply type_dist2_dist. apply Hfp.
    - rewrite /tctx_interp !big_sepL_zip_with /=. do 4 f_equiv.
      cut (∀ n tid p i, Proper (dist n ==> dist n)
        (λ (l : list type),
            match l !! i with
            | Some ty => tctx_elt_interp tid (p ◁ ty) | None => emp
            end)%I).
      { intros Hprop. apply Hprop, list_fmap_ne; last first.
        - symmetry. eapply Forall2_impl; first apply Hfp. intros.
          apply dist_later_dist, type_dist2_dist_later. done.
        - apply _. }
      clear. intros n tid p i x y. rewrite list_dist_lookup=>/(_ i).
      case _ : (x !! i)=>[tyx|]; case  _ : (y !! i)=>[tyy|];
        inversion_clear 1; [solve_proper|done].
  Qed.

  Global Instance fn_ne n' :
    Proper (pointwise_relation A (fn_params_rel (dist n')) ==> dist n') fn.
  Proof.
    intros ?? Hfp. apply dist_later_dist, type_dist2_dist_later.
    apply fn_type_contractive=>u. split; last split.
    - eapply Forall2_impl; first apply Hfp. intros. simpl.
      apply type_dist_dist2. done.
    - apply type_dist_dist2. apply Hfp.
    - apply Hfp.
  Qed.
End fn.

Global Arguments fn_params {_ _} _.

(* We use recursive notation for binders as well, to allow patterns
   like '(a, b) to be used. In practice, only one binder is ever used,
   but using recursive binders is the only way to make Coq accept
   patterns. *)
(* FIXME : because of a bug in Coq, such patterns only work for
   printing. Once on 8.6pl1, this should work.  *)
Notation "'fn(∀' x .. x' ',' E ';' T1 ',' .. ',' TN ')' '→' R" :=
  (fn (λ x, (.. (λ x',
      FP_wf E%EL (Vector.cons T1%T .. (Vector.cons TN%T Vector.nil) ..) R%T)..)))
  (at level 99, R at level 200, x binder, x' binder,
   format "'fn(∀'  x .. x' ','  E ';'  T1 ','  .. ','  TN ')'  '→'  R") : lrust_type_scope.
Notation "'fn(∀' x .. x' ',' E ')' '→' R" :=
  (fn (λ x, (.. (λ x', FP_wf E%EL Vector.nil R%T)..)))
  (at level 99, R at level 200, x binder, x' binder,
   format "'fn(∀'  x .. x' ','  E ')'  '→'  R") : lrust_type_scope.
Notation "'fn(' E ';' T1 ',' .. ',' TN ')' '→' R" :=
  (fn (λ _:(), FP_wf E%EL (Vector.cons T1%T .. (Vector.cons TN%T Vector.nil) ..) R%T))
  (at level 99, R at level 200,
   format "'fn(' E ';'  T1 ','  .. ','  TN ')'  '→'  R") : lrust_type_scope.
Notation "'fn(' E ')' '→' R" :=
  (fn (λ _:(), FP_wf E%EL Vector.nil R%T))
  (at level 99, R at level 200,
   format "'fn(' E ')'  '→'  R") : lrust_type_scope.

Global Instance elctx_empty : Empty (lft → elctx) := λ ϝ, [].

Section typing.
  Context `{!typeGS Σ}.

  Lemma fn_subtype {A n} E0 L0 (fp fp' : A → fn_params n) :
    (∀ x ϝ, let EE := E0 ++ (fp' x).(fp_E) ϝ in
            elctx_sat EE L0 ((fp x).(fp_E) ϝ) ∧
            Forall2 (subtype EE L0) (fp' x).(fp_tys) (fp x).(fp_tys) ∧
            subtype EE L0 (fp x).(fp_ty) (fp' x).(fp_ty)) →
    subtype E0 L0 (fn fp) (fn fp').
  Proof.
    intros Hcons. apply subtype_simple_type=>//= qmax qL. iIntros "HL0".
    (* We massage things so that we can throw away HL0 before going under the box. *)
    iAssert (∀ x ϝ, let EE := E0 ++ (fp' x).(fp_E) ϝ in □ (elctx_interp EE -∗
                 elctx_interp ((fp x).(fp_E) ϝ) ∗
                 ([∗ list] tys ∈ (zip (fp' x).(fp_tys) (fp x).(fp_tys)), type_incl (tys.1) (tys.2)) ∗
                 type_incl (fp x).(fp_ty) (fp' x).(fp_ty)))%I as "#Hcons".
    { iIntros (x ϝ). destruct (Hcons x ϝ) as (HE &Htys &Hty). clear Hcons.
      iDestruct (HE with "HL0") as "#HE".
      iDestruct (subtype_Forall2_llctx_noend with "HL0") as "#Htys"; first done.
      iDestruct (Hty with "HL0") as "#Hty".
      iClear "∗". iIntros "!> #HEE".
      iSplit; last iSplit.
      - by iApply "HE".
      - by iApply "Htys".
      - by iApply "Hty". }
    iClear "∗". clear Hcons. iIntros "!> #HE0 * Hf".
    iDestruct "Hf" as (fb kb xb e ?) "[% [% #Hf]]". subst.
    iExists fb, kb, xb, e, _. iSplit; first done. iSplit; first done. iNext.
    rewrite /typed_body. iIntros (x ϝ k xl) "!> * #LFT #HE' Htl HL HC HT".
    iDestruct ("Hcons" with "[$]") as "#(HE & Htys & Hty)".
    iApply ("Hf" with "LFT HE Htl HL [HC] [HT]").
    - unfold cctx_interp. iIntros (elt) "Helt".
      iDestruct "Helt" as %->%elem_of_list_singleton. iIntros (ret) "Htl HL HT".
      unfold cctx_elt_interp.
      iApply ("HC" $! (_ ◁cont(_, _)) with "[%] Htl HL [> -]").
      { by apply elem_of_list_singleton. }
      rewrite /tctx_interp !big_sepL_singleton /=.
      iDestruct "HT" as (v) "[HP Hown]". iExists v. iFrame "HP".
      iDestruct (box_type_incl with "[$Hty]") as "(_ & #Hincl & _)".
      by iApply "Hincl".
    - iClear "Hf". rewrite /tctx_interp
         -{2}(fst_zip (fp x).(fp_tys) (fp' x).(fp_tys)) ?vec_to_list_length //
         -{2}(snd_zip (fp x).(fp_tys) (fp' x).(fp_tys)) ?vec_to_list_length //
         !zip_with_fmap_r !(zip_with_zip (λ _ _, (_ ∘ _) _ _)) !big_sepL_fmap.
      iApply (big_sepL_impl with "HT"). iIntros "!>".
      iIntros (i [p [ty1' ty2']]) "#Hzip H /=".
      iDestruct "H" as (v) "[? Hown]". iExists v. iFrame.
      rewrite !lookup_zip_with.
      iDestruct "Hzip" as %(? & ? & ([? ?] & (? & Hty'1 &
        (? & Hty'2 & [=->->])%bind_Some)%bind_Some & [=->->->])%bind_Some)%bind_Some.
      iDestruct (big_sepL_lookup with "Htys") as "#Hty'".
      { rewrite lookup_zip_with /=. erewrite Hty'2. simpl. by erewrite Hty'1. }
      iDestruct (box_type_incl with "[$Hty']") as "(_ & #Hincl & _)".
      by iApply "Hincl".
  Qed.

  (* This proper and the next can probably not be inferred, but oh well. *)
  Global Instance fn_subtype' {A n} E0 L0 :
    Proper (pointwise_relation A (fn_params_rel (n:=n) (subtype E0 L0)) ==>
            subtype E0 L0) fn.
  Proof.
    intros fp1 fp2 Hfp. apply fn_subtype=>x ϝ. destruct (Hfp x) as (Htys & Hty & HE).
    split; last split.
    - rewrite (HE ϝ). solve_typing.
    - eapply Forall2_impl; first eapply Htys. intros ??.
      eapply subtype_weaken; last done. by apply submseteq_inserts_r.
    - eapply subtype_weaken, Hty; last done. by apply submseteq_inserts_r.
  Qed.

  Global Instance fn_eqtype' {A n} E0 L0 :
    Proper (pointwise_relation A (fn_params_rel (n:=n) (eqtype E0 L0)) ==>
            eqtype E0 L0) fn.
  Proof.
    intros fp1 fp2 Hfp. split; eapply fn_subtype=>x ϝ; destruct (Hfp x) as (Htys & Hty & HE); (split; last split).
    - rewrite (HE ϝ). solve_typing.
    - eapply Forall2_impl; first eapply Htys. intros t1 t2 Ht.
      eapply subtype_weaken; last apply Ht; last done. by apply submseteq_inserts_r.
    - eapply subtype_weaken; last apply Hty; last done. by apply submseteq_inserts_r.
    - rewrite (HE ϝ). solve_typing.
    - symmetry in Htys. eapply Forall2_impl; first eapply Htys. intros t1 t2 Ht.
      eapply subtype_weaken; last apply Ht; last done. by apply submseteq_inserts_r.
    - eapply subtype_weaken; last apply Hty; last done. by apply submseteq_inserts_r.
  Qed.

  Lemma fn_subtype_specialize {A B n} (σ : A → B) E0 L0 fp :
    subtype E0 L0 (fn (n:=n) fp) (fn (fp ∘ σ)).
  Proof.
    apply subtype_simple_type=>//= qmax qL.
    iIntros "_ !> _ * Hf". iDestruct "Hf" as (fb kb xb e ?) "[% [% #Hf]]". subst.
    iExists fb, kb, xb, e, _. iSplit; first done. iSplit; first done.
    rewrite /typed_body. iNext. iIntros "*". iApply "Hf".
  Qed.

  (* In principle, proving this hard-coded to an empty L would be sufficient --
     but then we would have to require elctx_sat as an Iris assumption. *)
  Lemma type_call_iris' E L (κs : list lft) {A} x (ps : list path) qκs qmax qL tid
        p (k : expr) (fp : A → fn_params (length ps)) :
    (∀ ϝ, elctx_sat (((λ κ, ϝ ⊑ₑ κ) <$> κs) ++ E) L ((fp x).(fp_E) ϝ)) →
    AsVal k →
    lft_ctx -∗ elctx_interp E -∗ na_own tid ⊤ -∗ llctx_interp_noend qmax L qL -∗
    qκs.[lft_intersect_list κs] -∗
    tctx_elt_interp tid (p ◁ fn fp) -∗
    ([∗ list] y ∈ zip_with TCtx_hasty ps (box <$> vec_to_list (fp x).(fp_tys)),
                   tctx_elt_interp tid y) -∗
    (∀ ret, na_own tid top -∗ llctx_interp_noend qmax L qL -∗ qκs.[lft_intersect_list κs] -∗
             (box (fp x).(fp_ty)).(ty_own) tid [ret] -∗
             WP k [of_val ret] {{ _, cont_postcondition }}) -∗
    WP (call: p ps → k) {{ _, cont_postcondition }}.
  Proof.
    iIntros (HE [k' <-]) "#LFT #HE Htl HL Hκs Hf Hargs Hk".
    wp_apply (wp_hasty with "Hf"). iIntros (v) "% Hf".
    iApply (wp_app_vec _ _ (_::_) ((λ v, ⌜v = (λ: ["_r"], k' ["_r"])%V⌝):::
               vmap (λ ty (v : val), tctx_elt_interp tid (v ◁ box ty)) (fp x).(fp_tys))%I
            with "[Hargs]").
    - rewrite /=. iSplitR "Hargs".
      { simpl. iApply wp_value. by unlock. }
      remember (fp_tys (fp x)) as tys. clear dependent k' p HE fp x.
      iInduction ps as [|p ps] "IH" forall (tys); first by simpl.
      simpl in tys. inv_vec tys=>ty tys. simpl.
      iDestruct "Hargs" as "[HT Hargs]". iSplitL "HT".
      + iApply (wp_hasty with "HT"). iIntros (?). rewrite tctx_hasty_val. iIntros "? $".
      + iApply "IH". done.
    - simpl. change (@length expr ps) with (length ps).
      iIntros (vl'). inv_vec vl'=>kv vl; csimpl.
      iIntros "[-> Hvl]". iDestruct "Hf" as (fb kb xb e ?) "[EQ [EQl #Hf]]".
      iDestruct "EQ" as %[=->]. iDestruct "EQl" as %EQl.
      revert vl fp HE. rewrite /= -EQl=>vl fp HE. wp_rec.
      iMod (lft_create with "LFT") as (ϝ_inner) "[Htk #Hend]"; first done.
      set (ϝ := ϝ_inner ⊓ lft_intersect_list κs).
      iSpecialize ("Hf" $! x ϝ _ vl). iDestruct (HE ϝ with "HL") as "#HE'".
      destruct (Qp_lower_bound qκs 1) as (q0 & q'1 & q'2 & -> & Hsum1).
      rewrite Hsum1. assert (q0 < 1)%Qp as Hq0.
      { apply Qp_lt_sum. eauto. }
      clear Hsum1.
      iDestruct "Htk" as "[Htk1 Htk2]".
      iDestruct "Hκs" as "[Hκs1 Hκs2]".
      iApply ("Hf" $! _ q0 with "LFT [] Htl [Hκs1 Htk1 Htk2] [Hk HL Hκs2]").
      + iApply "HE'". iFrame "HE".
        iIntros "{$# Hf Hend HE' LFT HE %}". subst ϝ.
        iApply big_sepL_forall.
        iIntros (i [κ1 κ2] [κ [Hpair Helem]]%elem_of_list_lookup_2%elem_of_list_fmap).
        injection Hpair as -> ->. iPureIntro. simpl.
        eapply lft_incl_syn_trans; first by apply lft_intersect_incl_syn_r.
        apply lft_intersect_list_elem_of_incl_syn.
        done.
      + iSplitL; last done. iExists ϝ. rewrite left_id. iSplit; first done.
        rewrite decide_False; last first.
        { apply Qp_lt_nge. done. }
        subst ϝ. rewrite -!lft_tok_sep. iFrame. iIntros "[Htk1 _]".
        rewrite -lft_dead_or. rewrite -bi.or_intro_l. iApply "Hend". iFrame.
      + iIntros (y) "IN {Hend}". iDestruct "IN" as %->%elem_of_list_singleton.
        iIntros (args) "Htl [Hϝ _] [Hret _]". inv_vec args=>r.
        iDestruct "Hϝ" as  (κ') "(EQ & Htk & _)". iDestruct "EQ" as %EQ.
        rewrite /= left_id in EQ. subst κ' ϝ.
        rewrite decide_False; last first.
        { apply Qp_lt_nge. done. }
        rewrite -lft_tok_sep. iDestruct "Htk" as "[_ Hκs1]". wp_rec.
        iApply ("Hk" with "Htl HL [$Hκs1 $Hκs2]"). rewrite tctx_hasty_val. done.
      + rewrite /tctx_interp vec_to_list_map !zip_with_fmap_r
                (zip_with_zip (λ v ty, (v, _))) zip_with_zip !big_sepL_fmap.
        iApply (big_sepL_mono' with "Hvl"); last done. by iIntros (i [v ty']).
  Qed.

  Lemma type_call_iris E (κs : list lft) {A} x (ps : list path) qκs tid
        f (k : expr) (fp : A → fn_params (length ps)) :
    (∀ ϝ, elctx_sat (((λ κ, ϝ ⊑ₑ κ) <$> κs) ++ E) [] ((fp x).(fp_E) ϝ)) →
    AsVal k →
    lft_ctx -∗ elctx_interp E -∗ na_own tid ⊤ -∗
    qκs.[lft_intersect_list κs] -∗
    (fn fp).(ty_own) tid [f] -∗
    ([∗ list] y ∈ zip_with TCtx_hasty ps (box <$> vec_to_list (fp x).(fp_tys)),
                   tctx_elt_interp tid y) -∗
    (∀ ret, na_own tid top -∗ qκs.[lft_intersect_list κs] -∗
             (box (fp x).(fp_ty)).(ty_own) tid [ret] -∗
             WP k [of_val ret] {{ _, cont_postcondition }}) -∗
    WP (call: f ps → k) {{ _, cont_postcondition }}.
  Proof.
    iIntros (HE Hk') "#LFT #HE Htl Hκs Hf Hargs Hk". rewrite -tctx_hasty_val.
    iApply (type_call_iris' with "LFT HE Htl [] Hκs Hf Hargs [Hk]"); [done..| |].
    - instantiate (1 := 1%Qp). instantiate (1 := 1%Qp). by rewrite /llctx_interp_noend.
    - iIntros "* Htl _". iApply "Hk". done.
  Qed.

  Lemma type_call' E L (κs : list lft) T p (ps : list path)
                   {A} (fp : A → fn_params (length ps)) (k : val) x :
    Forall (lctx_lft_alive E L) κs →
    (∀ ϝ, elctx_sat (((λ κ, ϝ ⊑ₑ κ) <$> κs) ++ E) L ((fp x).(fp_E) ϝ)) →
    ⊢ typed_body E L [k ◁cont(L, λ v : vec _ 1, ((v!!!0%fin:val) ◁ box (fp x).(fp_ty)) :: T)]
               ((p ◁ fn fp) ::
                zip_with TCtx_hasty ps (box <$> vec_to_list (fp x).(fp_tys)) ++
                T)
               (call: p ps → k).
  Proof.
    iIntros (Hκs HE tid qmax) "#LFT #HE Htl HL HC (Hf & Hargs & HT)".
    iMod (lctx_lft_alive_tok_list _ _ κs with "HE HL") as (q) "(Hκs & HL & Hclose)"; [done..|].
    iApply (type_call_iris' with "LFT HE Htl HL Hκs Hf Hargs"); [done|].
    iIntros (r) "Htl HL Hκs Hret". iMod ("Hclose" with "Hκs HL") as "HL".
    iSpecialize ("HC" with "[]"); first by (iPureIntro; apply elem_of_list_singleton).
    iApply ("HC" $! [#r] with "Htl HL").
    rewrite tctx_interp_cons tctx_hasty_val. iFrame.
  Qed.

  (* Specialized type_call':  Adapted for use by solve_typing.
     κs is still expected to be given manually. *)
  Lemma type_call {A} κs x E L C T T' T'' p (ps : list path)
                        (fp : A → fn_params (length ps)) k :
    p ◁ fn fp ∈ T →
    Forall (lctx_lft_alive E L) κs →
    (∀ ϝ, elctx_sat (((λ κ, ϝ ⊑ₑ κ) <$> κs) ++ E) L ((fp x).(fp_E) ϝ)) →
    tctx_extract_ctx E L (zip_with TCtx_hasty ps
                                   (box <$> vec_to_list (fp x).(fp_tys))) T T' →
    k ◁cont(L, T'') ∈ C →
    (∀ ret : val, tctx_incl E L ((ret ◁ box (fp x).(fp_ty))::T') (T'' [# ret])) →
    ⊢ typed_body E L C T (call: p ps → k).
  Proof.
    intros Hfn HL HE HTT' HC HT'T''.
    rewrite -typed_body_mono /flip; last done; first by eapply type_call'.
    - etrans.
      + eapply (incl_cctx_incl _ [_]); by intros ? ->%elem_of_list_singleton.
      + apply cctx_incl_cons; first done. intros args. by inv_vec args.
    - etrans; last by apply (tctx_incl_frame_l [_]).
      apply copy_elem_of_tctx_incl; last done. apply _.
  Qed.

  Lemma type_letcall {A} x E L C T T' p (ps : list path)
                        (fp : A → fn_params (length ps)) b e :
    Closed (b :b: []) e → Closed [] p → Forall (Closed []) ps →
    p ◁ fn fp ∈ T →
    Forall (lctx_lft_alive E L) (L.*1) →
    (∀ ϝ, elctx_sat (((λ κ, ϝ ⊑ₑ κ) <$> (L.*1)) ++ E) L ((fp x).(fp_E) ϝ)) →
    tctx_extract_ctx E L (zip_with TCtx_hasty ps
                                   (box <$> vec_to_list (fp x).(fp_tys))) T T' →
    (∀ ret : val, typed_body E L C ((ret ◁ box (fp x).(fp_ty))::T') (subst' b ret e)) -∗
    typed_body E L C T (letcall: b := p ps in e).
  Proof.
    iIntros (?? Hpsc ????) "He".
    iApply (type_cont_norec [_] _ (λ r, ((r!!!0%fin:val) ◁ box (fp x).(fp_ty)) :: T')).
    - (* TODO : make [solve_closed] work here. *)
      eapply is_closed_weaken; first done. set_solver+.
    - (* TODO : make [solve_closed] work here. *)
      rewrite /Closed /= !andb_True. split.
      + by eapply is_closed_weaken, list_subseteq_nil.
      + eapply Is_true_eq_left, forallb_forall, List.Forall_forall, Forall_impl=>//.
        intros. eapply Is_true_eq_true, is_closed_weaken=>//. set_solver+.
    - iIntros (k).
      (* TODO : make [simpl_subst] work here. *)
      change (subst' "_k" k (p ((λ: ["_r"], "_k" ["_r"])%E :: ps))) with
             ((subst "_k" k p) ((λ: ["_r"], k ["_r"])%E :: map (subst "_k" k) ps)).
      rewrite is_closed_nil_subst //.
      assert (map (subst "_k" k) ps = ps) as ->.
      { clear -Hpsc. induction Hpsc=>//=. rewrite is_closed_nil_subst //. congruence. }
      iApply type_call; try done.
      + constructor.
      + done.
    - simpl. iIntros (k ret). inv_vec ret=>ret. rewrite /subst_v /=.
      rewrite ->(is_closed_subst []); last set_solver+; last first.
      { apply subst'_is_closed; last done. apply is_closed_of_val. }
      (iApply typed_body_mono; last by iApply "He"); [|done..].
      apply incl_cctx_incl. set_solver+.
  Qed.

  Lemma type_rec {A} E L fb (argsb : list binder) ef e n
        (fp : A → fn_params n) T `{!CopyC T, !SendC T, !Closed _ e} :
    IntoVal ef (fnrec: fb argsb := e) →
    n = length argsb →
    □ (∀ x ϝ (f : val) k (args : vec val (length argsb)),
          typed_body ((fp x).(fp_E) ϝ) [ϝ ⊑ₗ []]
                     [k ◁cont([ϝ ⊑ₗ []], λ v : vec _ 1, [(v!!!0%fin:val) ◁ box (fp x).(fp_ty)])]
                     ((f ◁ fn fp) ::
                        zip_with (TCtx_hasty ∘ of_val) args
                                 (box <$> vec_to_list (fp x).(fp_tys)) ++ T)
                     (subst_v (fb :: BNamed "return" :: argsb) (f ::: k ::: args) e)) -∗
    typed_instruction_ty E L T ef (fn fp).
  Proof.
    iIntros (<- ->) "#Hbody /=". iIntros (tid qmax) "#LFT _ $ $ #HT". iApply wp_value.
    rewrite tctx_interp_singleton. iLöb as "IH". iExists _. iSplit.
    { simpl. rewrite decide_True_pi. done. }
    iExists fb, _, argsb, e, _. iSplit; first done. iSplit; first done. iNext.
    iIntros (x ϝ k args) "!>". iIntros (tid' qmax') "_ HE Htl HL HC HT'".
    iApply ("Hbody" with "LFT HE Htl HL HC").
    rewrite tctx_interp_cons tctx_interp_app. iFrame "HT' IH".
    by iApply sendc_change_tid.
  Qed.

  Lemma type_fn {A} E L (argsb : list binder) ef e n
        (fp : A → fn_params n) T `{!CopyC T, !SendC T, !Closed _ e} :
    IntoVal ef (fn: argsb := e) →
    n = length argsb →
    □ (∀ x ϝ k (args : vec val (length argsb)),
        typed_body ((fp x).(fp_E) ϝ)
                   [ϝ ⊑ₗ []]
                   [k ◁cont([ϝ ⊑ₗ []], λ v : vec _ 1, [(v!!!0%fin:val) ◁ box (fp x).(fp_ty)])]
                   (zip_with (TCtx_hasty ∘ of_val) args
                             (box <$> vec_to_list (fp x).(fp_tys)) ++ T)
                   (subst_v (BNamed "return" :: argsb) (k ::: args) e)) -∗
    typed_instruction_ty E L T ef (fn fp).
  Proof.
    iIntros (??) "#He". iApply type_rec; try done. iIntros "!> *".
    iApply typed_body_mono; last iApply "He"; try done.
    eapply contains_tctx_incl. by constructor.
  Qed.
End typing.

Global Hint Resolve fn_subtype : lrust_typing.


Require Import Coqlib.
Require Import ITreelib.
Require Import ImpPrelude.
Require Import STS.
Require Import Behavior.
Require Import ModSem.
Require Import Skeleton.
Require Import PCM.
Require Import HoareDef.
Require Import IntroHeader.
Import Plain.

Set Implicit Arguments.

Section PROOF.

  Context `{Σ: GRA.t}.
  Context `{@GRA.inG IRA.t Σ}.

  Definition Fsbtb: list (string * fspecbody) := [("f", mk_specbody f_spec (fun _ => trigger (Choose _)))].

  Definition FSem: SModSem.t := {|
    SModSem.fnsems := Fsbtb;
    SModSem.mn := "F";
    SModSem.initial_mr := ε;
    SModSem.initial_st := tt↑;
  |}
  .

  Definition F: Mod.t := (SMod.to_tgt (fun _ => GlobalStb)) {|
    SMod.get_modsem := fun _ => FSem;
    SMod.sk := [("f", Sk.Gfun)];
  |}.

End PROOF.


(* Test yet another way of importing heap_lang modules that used to break
printing *)
From iris.proofmode Require Import tactics.
From iris.heap_lang Require Export primitive_laws notation.
From iris.heap_lang Require Import proofmode notation.
Set Default Proof Using "Type".

Section printing_tests.
  Context `{!heapG Σ}.

  Lemma vs_print (P Q : iProp Σ) :
    P ={⊤}=∗ Q.
  Proof. Show. Abort.

  Lemma wp_print_long_expr (fun1 fun2 fun3 : expr) :
    True -∗ WP let: "val1" := fun1 #() in
       let: "val2" := fun2 "val1" in
       let: "val3" := fun3 "val2" in
       if: "val1" = "val2" then "val" else "val3"  {{ _, True }}.
  Proof.
    iIntros "_". Show.
  Abort.

  Lemma texan_triple_long_expr (fun1 fun2 fun3 : expr) :
    {{{ True }}}
       let: "val1" := fun1 #() in
       let: "val2" := fun2 "val1" in
       let: "val3" := fun3 "val2" in
       if: "val1" = "val2" then "val" else "val3"
    {{{ (x y : val) (z : Z), RET (x, y, #z); True }}}.
  Proof. Show. Abort.

End printing_tests.


Require Import Coq.omega.Omega.
Require Import Platform.AutoSep.
Require Import Platform.Cito.SyntaxExpr.

Require Import Bedrock.StringSet.
Import StringSet.
Require Import Coq.FSets.FSetProperties.
Module Import SSP := Properties StringSet.

Set Implicit Arguments.

Section ExprComp.

  Variable vars : list string.

  Variable temp_size : nat.

  Definition vars_start := 4 * 2.
  Definition var_slot x := LvMem (Sp + (vars_start + variablePosition vars x)%nat)%loc.
  Definition temp_start := vars_start + 4 * length vars.
  Definition temp_slot n := LvMem (Sp + (temp_start + 4 * n)%nat)%loc.

  Definition is_state sp vs temps : HProp :=
    (locals vars vs 0 (sp ^+ $8) *
     array temps (sp ^+ $8 ^+ $ (4 * length vars)))%Sep.

  Definition new_pre : assert :=
    x ~> ExX, Ex vs, Ex temps,
    ![^[is_state x#Sp vs temps] * #0]x /\
    [| length temps = temp_size |].

  Require Import Platform.Cito.SemanticsExpr.
  Require Import Platform.Cito.DepthExpr.
  Require Import Platform.Cito.ListFacts5.

  Local Open Scope nat.

  Definition runs_to expr base x_pre x :=
    forall specs other vs temps,
      interp specs (![is_state x_pre#Sp vs temps * other ] x_pre)
      -> length temps = temp_size
      -> Regs x Sp = x_pre#Sp /\
      exists changed,
        interp specs (![is_state (Regs x Sp) vs (upd_sublist temps base changed) * other ] (fst x_pre, x)) /\
        length changed <= depth expr /\
        Regs x Rv = eval vs expr.

  Definition post expr base (pre : assert) :=
    st ~> Ex st_pre,
    pre (fst st, st_pre) /\
    [| runs_to expr base (fst st, st_pre) (snd st) |].

  Definition imply (pre new_pre: assert) := forall specs x, interp specs (pre x) -> interp specs (new_pre x).

  Require Import Platform.Cito.FreeVarsExpr.

  Definition syn_req expr base :=
    Subset (free_vars expr) (of_list vars) /\
    base + depth expr <= temp_size.

  Definition verifCond expr base pre := imply pre new_pre :: syn_req expr base :: nil.

  Variable imports : LabelMap.t assert.

  Variable imports_global : importsGlobal imports.

  Variable modName : string.

  Definition Seq2 := @Seq_ _ imports_global modName.

  Definition Skip := Straightline_ imports modName nil.

  Fixpoint Seq ls :=
    match ls with
      | nil => Skip
      | a :: ls' => Seq2 a (Seq ls')
    end.

  Definition Strline := Straightline_ imports modName.

  Fixpoint do_compile (expr : Expr) (base : nat) :=
    match expr with
      | Var str => Strline (Assign (LvReg Rv) (RvLval (var_slot str)) :: nil)
      | Const w => Strline (Assign (LvReg Rv) (RvImm w) :: nil)
      | Binop op a b => Seq (
        do_compile a base ::
        Strline(Assign (temp_slot base) (RvLval (LvReg Rv)) :: nil) ::
        do_compile b (S base) ::
        (Strline (IL.Binop (LvReg Rv) (RvLval (temp_slot base)) op (RvLval (LvReg Rv)) :: nil)) :: nil)
      | TestE te a b => Seq (do_compile a base ::
        Strline( Assign (temp_slot base) (RvLval (LvReg Rv)) :: nil ) ::
        do_compile b (S base) ::
        Structured.If_ imports_global (RvLval (temp_slot base)) te (RvLval (LvReg Rv))
        (Strline (Assign Rv (RvImm $1) :: nil))
        (Strline (Assign Rv (RvImm $0) :: nil))
        ::nil)
    end.

  Definition body := do_compile.

  Require Import Platform.Wrap.

  Hint Extern 1 (_ <= _) => omega.

  Definition compile (expr : Expr) (base : nat) : cmd imports modName.
    refine (Wrap imports imports_global modName (body expr base) (post expr base) (verifCond expr base) _ _).

    Opaque mult.

    Lemma postOk : forall specs sm expr base pre st,
      Subset (free_vars expr) (of_list vars)
      -> base + depth expr <= temp_size
      -> interp specs (Postcondition (do_compile expr base pre) (sm, st))
      -> exists st', interp specs (pre (sm, st')) /\ runs_to expr base (sm, st') st.
      induction expr; simpl; propxFo.

      do 2 esplit.
      eauto.
      hnf.
      intros.
      unfold is_state in H; simpl in H.

      Lemma evalInstrs_read_var : forall sm x s,
        evalInstrs sm x (Assign Rv (var_slot s) :: nil)
        = evalInstrs sm x (Assign Rv (LvMem (Imm ((Regs x Sp ^+ natToW vars_start) ^+ natToW (variablePosition vars s)))) :: nil).
        Transparent evalInstrs.
        simpl.
        intros.
        replace (Regs x Sp ^+ natToW (vars_start + variablePosition vars s))
          with (Regs x Sp ^+ natToW vars_start ^+ natToW (variablePosition vars s)); auto.
        rewrite natToW_plus.
        words.
        Opaque evalInstrs.
      Qed.

      hnf in H.
      assert (In s (singleton s)).
      apply StringFacts.singleton_iff; auto.
      apply H in H5.

      Require Import Platform.Cito.SetoidListFacts.

      Lemma In_to_set :
        forall x ls,
          StringSet.In x (SSP.of_list ls)
          -> List.In x ls.
        intros.
        eapply SSP.of_list_1 in H.
        eapply InA_eq_In_iff; eauto.
      Qed.

      assert (List.In s vars) by eauto using In_to_set.
      rewrite evalInstrs_read_var in H3.
      unfold vars_start in H3.
      change (4 * 2) with 8 in *.
      clear_fancy.
      unfold is_state in H1; simpl in H1.
      evaluate auto_ext.
      simpl.
      intuition idtac.
      exists nil; simpl; intuition idtac.
      unfold is_state.
      rewrite H1.
      step auto_ext.
      auto.

      do 2 esplit; eauto.
      hnf; intros.
      simpl.
      clear_fancy.
      evaluate auto_ext.
      intuition idtac.
      exists nil; simpl; intuition.
      step auto_ext.

      apply IHexpr2 in H2; clear IHexpr2.
      Focus 2.
      hnf; intros.
      apply H.
      apply StringFacts.union_iff; auto.
      destruct H2; propxFo.
      apply IHexpr1 in H2; clear IHexpr1.
      Focus 2.
      hnf; intros.
      apply H.
      apply StringFacts.union_iff; auto.
      destruct H2; intuition.
      do 2 esplit; eauto.
      hnf; simpl; intros.
      unfold is_state in H1; simpl in H1.

      Lemma evalInstrs_write_temp : forall sm x base',
        evalInstrs sm x (Assign (temp_slot base') Rv :: nil)
        = evalInstrs sm x (Assign (LvMem (Imm (Regs x Sp ^+ $8 ^+ $ (4 * length vars) ^+ $4 ^* natToW base'))) Rv :: nil).
        Transparent evalInstrs.
        simpl.
        intros.
        replace (Regs x Sp ^+ natToW (temp_start + 4 * base'))
          with (Regs x Sp ^+ $ (8) ^+ $ (4 * length vars) ^+ $4 ^* natToW base'); auto.
        rewrite natToW_plus.
        unfold temp_start, vars_start.
        change (4 * 2) with 8.
        rewrite natToW_plus.
        unfold natToW.
        rewrite (Mult.mult_comm 4 base').
        change (natToWord 32 (base' * 4)) with (natToW (base' * 4)).
        rewrite (natToW_times4 base').
        unfold natToW.
        words.
        Opaque evalInstrs.
      Qed.

      Lemma evalInstrs_binop_temp : forall sm x base' b,
        evalInstrs sm x (IL.Binop Rv (temp_slot base') b Rv :: nil)
        = evalInstrs sm x (IL.Binop Rv (LvMem (Imm (Regs x Sp ^+ $8 ^+ $ (4 * length vars) ^+ $4 ^* natToW base'))) b Rv :: nil).
        Transparent evalInstrs.
        simpl.
        intros.
        replace (Regs x Sp ^+ natToW (temp_start + 4 * base'))
          with (Regs x Sp ^+ $ (8) ^+ $ (4 * length vars) ^+ $4 ^* natToW base'); auto.
        rewrite natToW_plus.
        unfold temp_start, vars_start.
        change (4 * 2) with 8.
        rewrite natToW_plus.
        unfold natToW.
        rewrite (Mult.mult_comm 4 base').
        change (natToWord 32 (base' * 4)) with (natToW (base' * 4)).
        rewrite (natToW_times4 base').
        unfold natToW.
        words.
        Opaque evalInstrs.
      Qed.

      rewrite evalInstrs_write_temp in H6.
      assert (natToW base < natToW (length temps))%word.
      apply lt_goodSize.
      assert (max (depth expr1) (S (depth expr2)) > 0).
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))).
      omega.
      omega.
      apply goodSize_weaken with (length temps); eauto.
      eauto.
      apply H7 in H1; clear H7.
      generalize H8; intro Hs.
      apply H1 in Hs; clear H1.
      destruct Hs as [ ? [ ? [ ? [ ] ] ] ]; simpl in *.
      generalize dependent H5; generalize dependent H4; generalize dependent H3.
      clear_fancy.
      unfold is_state in H7; simpl in H7.
      assert (natToW base < natToW (length (upd_sublist temps base x4)))%word.
      rewrite length_upd_sublist; assumption.
      evaluate auto_ext.
      intros.
      hnf in H14.
      assert (interp specs0 (![is_state ((sm, x1)) # (Sp) vs
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))* other] (sm, x1))).
      unfold is_state; simpl.
      clear_fancy; step auto_ext.
      replace (Regs x2 Sp) with (Regs x1 Sp) by words.
      step auto_ext.
      apply H15 in H16; clear H15.
      destruct H16 as [ ? [ ? [ ? [ ] ] ] ]; simpl in *.
      rewrite upd_length.
      rewrite length_upd_sublist.
      auto.
      rewrite evalInstrs_binop_temp in H14.
      clear_fancy.
      destruct b.
      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H16.
      evaluate auto_ext.
      intuition idtac.
      congruence.

      Lemma selN_updN_eq : forall a p v,
        p < length a
        -> selN (updN a p v) p = v.
        induction a; simpl; intuition.
        destruct p; simpl; intuition.
      Qed.

      Lemma sel_upd_eq : forall a p v,
        p < length a
        -> goodSize (length a)
        -> Array.sel (Array.upd a p v) p = v.
        unfold Array.sel, Array.upd; intros.
        apply selN_updN_eq; auto.
        rewrite wordToNat_natToWord_idempotent; auto.
        change (goodSize p).
        eapply goodSize_weaken; eauto.
      Qed.

      Lemma selN_updN_ne : forall a p v p',
        p <> p'
        -> selN (updN a p v) p' = selN a p'.
        induction a; simpl; intuition.
        destruct p, p'; simpl; intuition.
      Qed.

      Lemma sublist_irrel : forall base, goodSize base
        -> forall v base' a,
          base < base'
          -> Array.sel (upd_sublist a base' v) base = Array.sel a base.
        induction v; simpl; intuition.
        rewrite IHv; auto.
        rewrite sel_selN by auto.
        rewrite selN_updN_ne; try omega.
        unfold Array.sel.
        rewrite wordToNat_natToWord_idempotent; auto.
      Qed.

      rewrite sublist_irrel in H20.
      rewrite sel_upd_eq in H20.
      simpl.

      Lemma upd_sublist_unchanged : forall p ws a base,
        p < base
        -> Array.selN (upd_sublist a base ws) p = Array.selN a p.
        induction ws; simpl; intuition.
        rewrite IHws by omega.
        apply selN_updN_ne; omega.
      Qed.

      Lemma array_extensional : forall a1 a2,
        length a1 = length a2
        -> (forall p, p < length a1 -> selN a1 p = selN a2 p)
        -> a1 = a2.
        induction a1; destruct a2; simpl; intuition.
        injection H; clear H; intros.
        apply IHa1 in H; clear IHa1; subst.
        f_equal.
        specialize (H0 0); simpl in H0.
        auto.
        intros.
        specialize (H0 (S p)); simpl in H0.
        apply H0; omega.
      Qed.

      Lemma get_changed' : forall limit n a' a base,
        length a - base = n
        -> length a' = length a
        -> base <= limit
        -> (forall p, p < base -> Array.selN a' p = Array.selN a p)
        -> (forall p, p >= limit -> Array.selN a' p = Array.selN a p)
        -> exists changed, a' = upd_sublist a base changed
          /\ length changed <= limit - base.
        induction n; simpl; intros.

        exists nil.
        simpl; split.
        apply array_extensional; auto.
        auto.

        Require Import Coq.Arith.Arith.
        destruct (eq_nat_dec limit base); subst.

        (* We've reached the point where [a'] and [a] always agree, so no more updating is required. *)
        exists nil; intuition.
        unfold upd_sublist.
        apply array_extensional; intros; auto.
        destruct (le_lt_dec base p); auto.

        (* The current element is still allowed to change.  Keep inducting. *)
        assert (length (updN a base (selN a' base)) - S base = n)
          by (rewrite updN_length; omega).
        eapply IHn in H4.
        Focus 2.
        instantiate (1 := a').
        rewrite updN_length; auto.
        2: omega.
        Focus 2.
        intros.
        destruct (eq_nat_dec p base); subst.
        symmetry; apply selN_updN_eq.
        rewrite updN_length in H.
        omega.
        rewrite selN_updN_ne; auto.

        destruct H4.
        exists (selN a' base :: x).
        intuition idtac.
        simpl; omega.

        intros.
        rewrite selN_updN_ne; auto.
        omega.
      Qed.

      Lemma get_changed : forall a' a base limit,
        length a' = length a
        -> base <= limit
        -> (forall p, p < base -> Array.selN a' p = Array.selN a p)
        -> (forall p, p >= limit -> Array.selN a' p = Array.selN a p)
        -> exists changed, a' = upd_sublist a base changed
          /\ length changed <= limit - base.
        intros; eapply get_changed'; eauto.
      Qed.

      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H22.
      destruct H22.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H23.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 2.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H23.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.

      Lemma upd_sublist_unchanged_high : forall p ws a base,
        p >= base + length ws
        -> Array.selN (upd_sublist a base ws) p = Array.selN a p.
        induction ws; simpl; intuition.
        rewrite IHws by omega.
        apply selN_updN_ne; omega.
      Qed.

      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H23.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      apply lt_goodSize'; auto.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      repeat (rewrite length_upd_sublist || rewrite upd_length); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      repeat (rewrite length_upd_sublist || rewrite upd_length); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      repeat (rewrite length_upd_sublist || rewrite upd_length); omega.
      omega.

      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H16.
      evaluate auto_ext.
      intuition idtac.
      congruence.
      rewrite sublist_irrel in H20.
      rewrite sel_upd_eq in H20.
      simpl.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H22.
      destruct H22.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H23.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 2.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H23.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H23.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      apply lt_goodSize'; auto.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      repeat (rewrite length_upd_sublist || rewrite upd_length); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      repeat (rewrite length_upd_sublist || rewrite upd_length); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      repeat (rewrite length_upd_sublist || rewrite upd_length); omega.
      omega.

      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H16.
      evaluate auto_ext.
      intuition idtac.
      congruence.
      rewrite sublist_irrel in H20.
      rewrite sel_upd_eq in H20.
      simpl.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H22.
      destruct H22.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H23.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 2.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H23.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H23.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      apply lt_goodSize'; auto.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      repeat (rewrite length_upd_sublist || rewrite upd_length); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      repeat (rewrite length_upd_sublist || rewrite upd_length); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      repeat (rewrite length_upd_sublist || rewrite upd_length); omega.
      omega.

      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l.
      omega.

      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r.
      omega.

      apply IHexpr2 in H1; clear IHexpr2.
      Focus 2.
      do 2 intro.
      apply H.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r.
      omega.
      destruct H1; propxFo.
      apply IHexpr1 in H2; clear IHexpr1.
      Focus 2.
      do 2 intro.
      apply H.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l.
      omega.
      destruct H2; intuition idtac.
      do 2 esplit; eauto.
      hnf; simpl; intros.
      apply H8 in H1; clear H8.
      generalize H9; intro Hs.
      apply H1 in Hs; clear H1.
      simpl in Hs; destruct Hs as [ ? [ ? [ ? [ ] ] ] ].
      rewrite evalInstrs_write_temp in *.

      Lemma evalCond_temp : forall sm x base' t0,
        evalCond (temp_slot base') t0 Rv sm x
        = evalCond (LvMem (Imm (Regs x Sp ^+ $8 ^+ $ (4 * length vars) ^+ $4 ^* natToW base'))) t0 Rv sm x.
        unfold evalCond; simpl; intros.
        replace (Regs x Sp ^+ natToW (temp_start + 4 * base'))
          with (Regs x Sp ^+ $ (8) ^+ $ (4 * length vars) ^+ $4 ^* natToW base'); auto.
        rewrite natToW_plus.
        unfold temp_start, vars_start.
        change (4 * 2) with 8.
        rewrite natToW_plus.
        unfold natToW.
        rewrite (Mult.mult_comm 4 base').
        change (natToWord 32 (base' * 4)) with (natToW (base' * 4)).
        rewrite (natToW_times4 base').
        unfold natToW.
        words.
      Qed.

      rewrite evalCond_temp in *.
      clear_fancy.
      generalize dependent H3; generalize dependent H4; generalize dependent H5.
      unfold is_state in H8.
      assert (natToW base < natToW (length (upd_sublist temps base x4)))%word.
      rewrite length_upd_sublist.
      apply lt_goodSize; auto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      apply goodSize_weaken with (length (upd_sublist temps base x4)); eauto.
      rewrite length_upd_sublist; auto.
      apply goodSize_weaken with (length (upd_sublist temps base x4)); eauto.
      rewrite length_upd_sublist; auto.
      evaluate auto_ext.
      intros.
      assert (interp specs0 (![is_state ((sm, x1)) # (Sp) vs
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))* other] (sm, x1))).
      unfold is_state; simpl.
      clear_fancy; step auto_ext.
      replace (Regs x2 Sp) with (Regs x1 Sp) by words.
      step auto_ext.
      clear H12; apply H6 in H16.
      rewrite upd_length in H16.
      rewrite length_upd_sublist in H16.
      generalize H9; intro Hs.
      apply H16 in Hs; clear H16.
      simpl in Hs; destruct Hs as [ ? [ ? [ ? [ ] ] ] ].
      unfold is_state in H16; simpl in H16.
      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1)) (S base) x5)))%word.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      apply lt_goodSize; auto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      auto.
      generalize dependent H14.
      destruct t0; simpl.

      evaluate auto_ext.
      intros; evaluate auto_ext.
      intuition.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H24.
      destruct H24.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H25.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 3.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      unfold Array.sel in H22.
      rewrite upd_sublist_unchanged in H22.
      unfold Array.upd in H22.
      rewrite selN_updN_eq in H22.
      generalize (weqb_true_iff (eval vs expr1) (eval vs expr2)).
      unfold weqb.
      destruct (Word.weqb (eval vs expr1) (eval vs expr2)); intuition (try discriminate).
      rewrite length_upd_sublist.
      rewrite wordToNat_natToWord_idempotent.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      rewrite wordToNat_natToWord_idempotent.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.

      evaluate auto_ext.
      intros; evaluate auto_ext.
      intuition.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H24.
      destruct H24.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H25.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 3.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      unfold Array.sel in H22.
      rewrite upd_sublist_unchanged in H22.
      unfold Array.upd in H22.
      rewrite selN_updN_eq in H22.
      unfold wneb.
      destruct (weq (eval vs expr1) (eval vs expr2)); auto.
      exfalso; eauto.
      rewrite length_upd_sublist.
      rewrite wordToNat_natToWord_idempotent.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      rewrite wordToNat_natToWord_idempotent.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.

      evaluate auto_ext.
      intros; evaluate auto_ext.
      intuition.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H24.
      destruct H24.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H25.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 3.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      unfold Array.sel in H22.
      rewrite upd_sublist_unchanged in H22.
      unfold Array.upd in H22.
      rewrite selN_updN_eq in H22.
      unfold wltb.
      destruct (wlt_dec (eval vs expr1) (eval vs expr2)); intuition (try discriminate).
      rewrite length_upd_sublist.
      rewrite wordToNat_natToWord_idempotent.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      rewrite wordToNat_natToWord_idempotent.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.

      evaluate auto_ext.
      intros; evaluate auto_ext.
      intuition.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H24.
      destruct H24.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H25.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 3.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      unfold Array.sel in H22.
      rewrite upd_sublist_unchanged in H22.
      unfold Array.upd in H22.
      rewrite selN_updN_eq in H22.
      unfold wleb.
      destruct (weq (eval vs expr1) (eval vs expr2)); intuition (try discriminate).
      destruct (wlt_dec (eval vs expr1) (eval vs expr2)); intuition (try discriminate).
      apply le_neq_lt in n; tauto.
      rewrite length_upd_sublist.
      rewrite wordToNat_natToWord_idempotent.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      rewrite wordToNat_natToWord_idempotent.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.

      apply IHexpr2 in H1; clear IHexpr2.
      Focus 2.
      do 2 intro.
      apply H.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r.
      omega.
      destruct H1; propxFo.
      apply IHexpr1 in H2; clear IHexpr1.
      Focus 2.
      do 2 intro.
      apply H.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l.
      omega.
      destruct H2; intuition idtac.
      do 2 esplit; eauto.
      hnf; simpl; intros.
      apply H8 in H1; clear H8.
      generalize H9; intro Hs.
      apply H1 in Hs; clear H1.
      simpl in Hs; destruct Hs as [ ? [ ? [ ? [ ] ] ] ].
      rewrite evalInstrs_write_temp in *.
      rewrite evalCond_temp in *.
      clear_fancy.
      generalize dependent H3; generalize dependent H4; generalize dependent H5.
      unfold is_state in H8.
      assert (natToW base < natToW (length (upd_sublist temps base x4)))%word.
      rewrite length_upd_sublist.
      apply lt_goodSize; auto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      apply goodSize_weaken with (length (upd_sublist temps base x4)); eauto.
      rewrite length_upd_sublist; auto.
      apply goodSize_weaken with (length (upd_sublist temps base x4)); eauto.
      rewrite length_upd_sublist; auto.
      evaluate auto_ext.
      intros.
      assert (interp specs0 (![is_state ((sm, x1)) # (Sp) vs
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))* other] (sm, x1))).
      unfold is_state; simpl.
      clear_fancy; step auto_ext.
      replace (Regs x2 Sp) with (Regs x1 Sp) by words.
      step auto_ext.
      clear H12; apply H6 in H16.
      rewrite upd_length in H16.
      rewrite length_upd_sublist in H16.
      generalize H9; intro Hs.
      apply H16 in Hs; clear H16.
      simpl in Hs; destruct Hs as [ ? [ ? [ ? [ ] ] ] ].
      unfold is_state in H16; simpl in H16.
      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1)) (S base) x5)))%word.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      apply lt_goodSize; auto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      auto.
      generalize dependent H14.
      destruct t0; simpl.

      evaluate auto_ext.
      intros; evaluate auto_ext.
      intuition.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H24.
      destruct H24.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H25.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 3.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      unfold Array.sel in H22.
      rewrite upd_sublist_unchanged in H22.
      unfold Array.upd in H22.
      rewrite selN_updN_eq in H22.
      generalize (weqb_true_iff (eval vs expr1) (eval vs expr2)).
      unfold weqb.
      destruct (Word.weqb (eval vs expr1) (eval vs expr2)); intuition (try discriminate).
      rewrite length_upd_sublist.
      rewrite wordToNat_natToWord_idempotent.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      rewrite wordToNat_natToWord_idempotent.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.

      evaluate auto_ext.
      intros; evaluate auto_ext.
      intuition.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H24.
      destruct H24.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H25.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 3.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      unfold Array.sel in H22.
      rewrite upd_sublist_unchanged in H22.
      unfold Array.upd in H22.
      rewrite selN_updN_eq in H22.
      unfold wneb.
      destruct (weq (eval vs expr1) (eval vs expr2)); auto.
      exfalso; eauto.
      rewrite length_upd_sublist.
      rewrite wordToNat_natToWord_idempotent.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      rewrite wordToNat_natToWord_idempotent.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.

      evaluate auto_ext.
      intros; evaluate auto_ext.
      intuition.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H24.
      destruct H24.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H25.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 3.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      unfold Array.sel in H22.
      rewrite upd_sublist_unchanged in H22.
      unfold Array.upd in H22.
      rewrite selN_updN_eq in H22.
      unfold wltb.
      destruct (wlt_dec (eval vs expr1) (eval vs expr2)); intuition (try discriminate).
      rewrite length_upd_sublist.
      rewrite wordToNat_natToWord_idempotent.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      rewrite wordToNat_natToWord_idempotent.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.

      evaluate auto_ext.
      intros; evaluate auto_ext.
      intuition.
      assert (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base (eval vs expr1))
        (S base) x5) = length temps).
      rewrite length_upd_sublist.
      rewrite upd_length.
      apply length_upd_sublist.
      eapply get_changed in H24.
      destruct H24.
      eexists; intuition idtac.
      unfold is_state.
      rewrite <- H25.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs st Sp) by congruence.
      step auto_ext.
      Focus 3.
      instantiate (1 := base + max (depth expr1) (S (depth expr2))).
      omega.
      omega.
      unfold Array.sel in H22.
      rewrite upd_sublist_unchanged in H22.
      unfold Array.upd in H22.
      rewrite selN_updN_eq in H22.
      unfold wleb.
      destruct (weq (eval vs expr1) (eval vs expr2)); intuition (try discriminate).
      rewrite e in H22.
      exfalso; eapply wlt_not_refl; eauto.
      destruct (wlt_dec (eval vs expr1) (eval vs expr2)); intuition (try discriminate).
      apply lt_le in w.
      exfalso; apply w; auto.
      rewrite length_upd_sublist.
      rewrite wordToNat_natToWord_idempotent.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      rewrite wordToNat_natToWord_idempotent.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      intros.
      rewrite upd_sublist_unchanged by omega.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged; auto.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)).
      eauto.
      rewrite length_upd_sublist.
      rewrite upd_length.
      rewrite length_upd_sublist.
      omega.
      intros.
      rewrite upd_sublist_unchanged_high.
      unfold Array.upd.
      rewrite selN_updN_ne.
      apply upd_sublist_unchanged_high.
      generalize (Max.le_max_l (depth expr1) (S (depth expr2))); omega.
      intro; subst.
      rewrite wordToNat_natToWord_idempotent in H25.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      change (goodSize base).
      apply goodSize_weaken with (length (upd_sublist
        (Array.upd (upd_sublist temps base x4) base
          (eval vs expr1)) (S base) x5)); eauto.
      generalize (Max.le_max_r (depth expr1) (S (depth expr2))); omega.
      (* Sorry for all that copying and pasting. ;-) *)
    Qed.

    abstract (unfold verifCond, syn_req; wrap0;
      match goal with
        | [ H : interp _ (Postcondition _ ?x) |- _ ] =>
          destruct x; eapply postOk in H; auto; destruct H; intuition; descend; eauto
      end).

    unfold verifCond, syn_req; wrap0.

    Lemma verifCondOk : forall expr base pre,
      imply pre new_pre
      -> Subset (free_vars expr) (of_list vars)
      -> base + depth expr <= temp_size
      -> vcs (VerifCond (body expr base pre)).
      induction expr; wrap0; simpl in *.

      apply H in H2; clear H; post.
      unfold is_state in H2.
      rewrite evalInstrs_read_var in *.
      unfold vars_start in *.
      change (4 * 2) with 8 in *.
      unfold natToW in H3.
      assert (List.In s vars).
      apply In_to_set.
      apply H0.
      apply StringFacts.singleton_iff; auto.
      clear_fancy.
      evaluate auto_ext.

      clear_fancy.
      clear H.
      evaluate auto_ext.

      apply IHexpr1; auto.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l; omega.

      apply postOk in H2.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l; omega.
      destruct H2 as [ ? [ ? ] ].
      apply H in H2; clear H.
      post.
      apply H4 in H2; intuition idtac.
      simpl in *.
      destruct H6; intuition idtac.
      unfold is_state in H6.
      rewrite evalInstrs_write_temp in *.
      assert (natToW base < natToW (length (upd_sublist x2 base x3)))%word.
      rewrite length_upd_sublist.
      apply lt_goodSize.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length (upd_sublist x2 base x3)); eauto.
      rewrite length_upd_sublist.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length (upd_sublist x2 base x3)); eauto.
      rewrite length_upd_sublist.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      clear IHexpr1 IHexpr2; clear_fancy.
      evaluate auto_ext.

      apply IHexpr2.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      hnf; propxFo.
      apply postOk in H3.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l; omega.
      destruct H3; intuition idtac.
      apply H in H3; clear H; post.
      apply H5 in H2; clear H5; intuition idtac; simpl in *.
      destruct H5; intuition idtac.
      clear IHexpr1 IHexpr2; clear_fancy.
      rewrite evalInstrs_write_temp in *.
      unfold is_state in H5.
      assert (natToW base < natToW (length (upd_sublist x4 base x5)))%word.
      rewrite length_upd_sublist.
      apply lt_goodSize.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length (upd_sublist x4 base x5)); eauto.
      rewrite length_upd_sublist.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length (upd_sublist x4 base x5)); eauto.
      rewrite length_upd_sublist.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      evaluate auto_ext.
      destruct x; simpl in *.
      descend.
      unfold is_state.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs s0 Sp) by congruence.
      step auto_ext.
      rewrite upd_length.
      rewrite length_upd_sublist; assumption.

      apply postOk in H2.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      post.
      post.
      apply postOk in H4.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l; omega.
      destruct H4; intuition idtac.
      apply H in H4; clear H.
      clear IHexpr1 IHexpr2; clear_fancy.
      post.
      apply H7 in H2; clear H7.
      post.
      rewrite evalInstrs_write_temp in *.
      unfold is_state in H7.
      assert (natToW base < natToW (length (upd_sublist x4 base x5)))%word.
      rewrite length_upd_sublist.
      apply lt_goodSize.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length (upd_sublist x4 base x5)); eauto.
      rewrite length_upd_sublist.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length (upd_sublist x4 base x5)); eauto.
      rewrite length_upd_sublist.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      evaluate auto_ext.
      assert (interp specs (![is_state (Regs x Sp) x3
        (Array.upd (upd_sublist x4 base x5) base (eval x3 expr1))* (fun stn sm => x2 (stn, sm))] (stn, x))).
      unfold is_state.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs x Sp) by congruence.
      step auto_ext.
      apply H5 in H13.
      rewrite upd_length in H13.
      rewrite length_upd_sublist in H13.
      post.
      rewrite evalInstrs_binop_temp in *.
      destruct b.

      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist x4 base x5) base
          (eval x3 expr1)) (S base) x6)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H15.
      evaluate auto_ext.

      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist x4 base x5) base
          (eval x3 expr1)) (S base) x6)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H15.
      evaluate auto_ext.

      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist x4 base x5) base
          (eval x3 expr1)) (S base) x6)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H15.
      evaluate auto_ext.

      Transparent evalInstrs.
      simpl in H3.
      discriminate.
      Opaque evalInstrs.

      apply IHexpr1; auto.
      hnf; intros.
      apply H0.
      apply StringFacts.union_iff; auto.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l; omega.

      apply postOk in H2.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l; omega.
      post.
      apply H in H4; clear H; post.
      rewrite evalInstrs_write_temp in *.
      unfold is_state in H2.
      assert (natToW base < natToW (length x2))%word.
      apply lt_goodSize.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length x2); eauto.
      eauto.
      clear IHexpr1 IHexpr2; clear_fancy.
      evaluate auto_ext.
      assert (interp specs (![is_state (Regs x Sp) x1 x2 * (fun stn sm => x0 (stn, sm))] (stn, x))).
      unfold is_state.
      step auto_ext.
      apply H5 in H2.
      post.
      assert (natToW base < natToW (length (upd_sublist x2 base x3)))%word.
      rewrite length_upd_sublist; assumption.
      clear H8; unfold is_state in H7.
      evaluate auto_ext.

      apply IHexpr2; auto.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      hnf; post.
      apply postOk in H3.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l; omega.
      post.
      apply H in H3; clear H; post.
      apply H5 in H2; clear H5; post.
      rewrite evalInstrs_write_temp in *.
      unfold is_state in H5.
      assert (natToW base < natToW (length (upd_sublist x4 base x5)))%word.
      rewrite length_upd_sublist.
      apply lt_goodSize.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length (upd_sublist x4 base x5)); eauto.
      rewrite length_upd_sublist; auto.
      apply goodSize_weaken with (length (upd_sublist x4 base x5)); eauto.
      rewrite length_upd_sublist; auto.
      clear IHexpr1 IHexpr2; clear_fancy.
      evaluate auto_ext.
      destruct x; simpl in *.
      descend.
      unfold is_state.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs s0 Sp) by congruence.
      step auto_ext.
      rewrite upd_length.
      rewrite length_upd_sublist; auto.

      apply postOk in H2.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      post.
      post.
      apply postOk in H4.
      Focus 2.
      do 2 intro.
      apply H0.
      apply StringFacts.union_iff; auto.
      Focus 2.
      assert (max (depth expr1) (S (depth expr2)) >= depth expr1) by apply Max.le_max_l; omega.
      destruct H4; intuition idtac.
      apply H in H4; clear H.
      clear IHexpr1 IHexpr2; clear_fancy.
      post.
      apply H7 in H2; clear H7.
      post.
      rewrite evalInstrs_write_temp in *.
      unfold is_state in H7.
      assert (natToW base < natToW (length (upd_sublist x4 base x5)))%word.
      rewrite length_upd_sublist.
      apply lt_goodSize.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length (upd_sublist x4 base x5)); eauto.
      rewrite length_upd_sublist.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      apply goodSize_weaken with (length (upd_sublist x4 base x5)); eauto.
      rewrite length_upd_sublist.
      assert (max (depth expr1) (S (depth expr2)) >= S (depth expr2)) by apply Max.le_max_r; omega.
      evaluate auto_ext.
      assert (interp specs (![is_state (Regs x Sp) x3
        (Array.upd (upd_sublist x4 base x5) base (eval x3 expr1))* (fun stn sm => x2 (stn, sm))] (stn, x))).
      unfold is_state.
      step auto_ext.
      replace (Regs x0 Sp) with (Regs x Sp) by congruence.
      step auto_ext.
      apply H5 in H13.
      rewrite upd_length in H13.
      rewrite length_upd_sublist in H13.
      post.
      rewrite evalCond_temp in *.
      destruct t0.

      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist x4 base x5) base
          (eval x3 expr1)) (S base) x6)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H15.
      evaluate auto_ext.

      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist x4 base x5) base
          (eval x3 expr1)) (S base) x6)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H15.
      evaluate auto_ext.

      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist x4 base x5) base
          (eval x3 expr1)) (S base) x6)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H15.
      evaluate auto_ext.

      assert (natToW base < natToW (length (upd_sublist
        (Array.upd (upd_sublist x4 base x5) base
          (eval x3 expr1)) (S base) x6)))%word.
      rewrite length_upd_sublist; rewrite upd_length; assumption.
      clear H12; unfold is_state in H15.
      evaluate auto_ext.

      Transparent evalInstrs.
      discriminate.
      discriminate.
      discriminate.
      discriminate.
      Opaque evalInstrs.
    Qed.

    abstract (apply verifCondOk; auto).
  Defined.

End ExprComp.


Require Import Coq.ZArith.ZArith.
Require Import Coq.Strings.String.
Require Import Coq.micromega.Lia.
Require Import Coq.derive.Derive.
Require Import bedrock2.Syntax.
Require Import compiler.FlatToRiscvDef.
Require Export compiler.MemoryLayout.
Require Import compiler.Pipeline.
Require Import compiler.RiscvWordProperties.
Require Import coqutil.Word.Interface.
Require Import coqutil.Map.Z_keyed_SortedListMap.
Require Import coqutil.Z.HexNotation.
Require Import Bedrock2Experiments.WordProperties.
Require Import Bedrock2Experiments.StateMachineMMIO.
Require Import Bedrock2Experiments.StateMachineSemantics.
Require Import Bedrock2Experiments.Aes.Constants.
Require Import Bedrock2Experiments.Aes.Aes.
Require Import Bedrock2Experiments.Aes.AesSemantics.
Require Import Bedrock2Experiments.LibBase.AbsMMIO.
Require coqutil.Word.Naive.
Require coqutil.Map.SortedListWord.
Require riscv.Utility.InstructionNotations.
Import Syntax.Coercions.
Local Open Scope string_scope.

Instance word: word.word 32 := Naive.word 32.
Instance mem: map.map word Byte.byte := SortedListWord.map _ _.
Existing Instance SortedListString.map.
Existing Instance SortedListString.ok.

(* TODO: we actually need a different word implementation than Naive here; in
   corner cases such as a shift argument greater than the width of the word,
   the naive implementation violates the riscv_ok requirements *)
Instance naive_riscv_ok : word.riscv_ok word. Admitted.

Definition ml: MemoryLayout := {|
  MemoryLayout.code_start    := word.of_Z 0;
  MemoryLayout.code_pastend  := word.of_Z (4*2^10);
  MemoryLayout.heap_start    := word.of_Z (4*2^10);
  MemoryLayout.heap_pastend  := word.of_Z (8*2^10);
  MemoryLayout.stack_start   := word.of_Z (8*2^10);
  MemoryLayout.stack_pastend := word.of_Z (16*2^10);
                              |}.

(* Magic number for aes base address found in
   third_party/opentitan/hw/top_earlgrey/sw/autogen/top_earlgrey.h:

   #define TOP_EARLGREY_AES_BASE_ADDR 0x40110000u *)
Definition AES_BASE_ADDR : Z := 0x40110000.

Local Infix "<<" := Z.shiftl (at level 40) : Z_scope.
Instance consts : aes_constants Z :=
  {|
  (**** Constants from aes_regs.h ****)

  (* #define AES_KEY0(id) (AES##id##_BASE_ADDR + 0x0) *)
  AES_KEY00 := AES_BASE_ADDR + 0x0;

  (* #define AES_IV0(id) (AES##id##_BASE_ADDR + 0x20) *)
  AES_IV00 := AES_BASE_ADDR + 0x20;

  (* #define AES_DATA_IN0(id) (AES##id##_BASE_ADDR + 0x30) *)
  AES_DATA_IN00 := AES_BASE_ADDR + 0x30;

  (* #define AES_DATA_OUT0(id) (AES##id##_BASE_ADDR + 0x40) *)
  AES_DATA_OUT00 := AES_BASE_ADDR + 0x40;

  (* #define AES_CTRL(id) (AES##id##_BASE_ADDR + 0x50) *)
  AES_CTRL0 := AES_BASE_ADDR + 0x50;

  (* #define AES_CTRL_REG_OFFSET 0x50
     #define AES_CTRL_OPERATION 0
     #define AES_CTRL_MODE_MASK 0x7
     #define AES_CTRL_MODE_OFFSET 1
     #define AES_CTRL_KEY_LEN_MASK 0x7
     #define AES_CTRL_KEY_LEN_OFFSET 4
     #define AES_CTRL_MANUAL_OPERATION 7 *)
  AES_CTRL_OPERATION := 0;
  AES_CTRL_MODE_MASK := 0x7;
  AES_CTRL_MODE_OFFSET := 1;
  AES_CTRL_KEY_LEN_MASK := 0x7;
  AES_CTRL_KEY_LEN_OFFSET := 4;
  AES_CTRL_MANUAL_OPERATION := 7;

  (* #define AES_STATUS(id) (AES##id##_BASE_ADDR + 0x58) *)
  AES_STATUS0 := AES_BASE_ADDR + 0x58;

  (* #define AES_STATUS_IDLE 0
     #define AES_STATUS_STALL 1
     #define AES_STATUS_OUTPUT_VALID 2
     #define AES_STATUS_INPUT_READY 3 *)
  AES_STATUS_IDLE := 0;
  AES_STATUS_STALL := 1;
  AES_STATUS_OUTPUT_VALID := 2;
  AES_STATUS_INPUT_READY := 3;

  (* #define AES_PARAM_NUMREGSKEY 8 *)
  AES_NUM_REGS_KEY := 8;

  (* #define AES_PARAM_NUMREGSIV 4 *)
  AES_NUM_REGS_IV := 4;

  (* #define AES_PARAM_NUMREGSDATA 4 *)
  AES_NUM_REGS_DATA := 4;

  (**** Enums from aes.h ****)

  (* typedef enum aes_op { kAesEnc = 0, kAesDec = 1 } aes_op_t; *)
  kAesEnc := 0;
  kAesDec := 1;

  (* typedef enum aes_mode {
       kAesEcb = 1 << 0,
       kAesCbc = 1 << 1,
       kAesCtr = 1 << 2
     } aes_mode_t; *)
  kAesEcb := 1 << 0;
  kAesCbc := 1 << 1;
  kAesCtr := 1 << 2;

  (* typedef enum aes_key_len {
       kAes128 = 1 << 0,
       kAes192 = 1 << 1,
       kAes256 = 1 << 2
     } aes_key_len_t; *)
  kAes128 := 1 << 0;
  kAes192 := 1 << 1;
  kAes256 := 1 << 2;

  |}.

Instance aes_timing : timing := {| ndelays_core := 14%nat |}.

(* TODO: fill in with real circuit spec *)
Instance aes_def: AesSpec. constructor. Admitted.

Existing Instance constant_literals.

Definition funcs := [ aes_data_put_wait
                     ; aes_data_get_wait
                     ; aes_init
                     ; aes_key_put
                     ; aes_iv_put
                     ; aes_data_put
                     ; aes_data_get
                     ; aes_data_ready
                     ; aes_data_valid
                     ; aes_idle
                     ; abs_mmio_read32
                     ; abs_mmio_write32 ].

Derive aes_compile_result
       SuchThat (compile compile_ext_call (map.of_list funcs)
                 = Some aes_compile_result)
       As aes_compile_result_eq.
Proof.
  (* doing a more surgical vm_compute in the lhs only avoids fully computing the map
     type, which would slow eq_refl and Qed dramatically *)
  lazymatch goal with
    |- ?lhs = _ =>
    let x := (eval vm_compute in lhs) in
    change lhs with x
  end.
  exact eq_refl.
Qed.

Definition aes_asm := Eval compute in fst (fst aes_compile_result).

Module PrintAssembly.
  Import riscv.Utility.InstructionNotations.
  Redirect "aes.s" Print aes_asm.
End PrintAssembly.