Require Import Coq.Program.Basics.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Program.Combinators.
Require Import omega.Omega.
Require Import Setoid.
Require Import ZArith.
Require Import Psatz.

Require Import FinProof.Common.
Require Import FinProof.CommonInstances.
Require Import FinProof.StateMonad2.
Require Import FinProof.StateMonadInstances.
Require Import FinProof.ProgrammingWith.

Local Open Scope struct_scope.

Require Import FinProof.CommonProofs.
Require Import depoolContract.ProofEnvironment.
Require Import depoolContract.DePoolClass.
Require Import depoolContract.SolidityNotations.

Require Import depoolContract.DePoolFunc.
Module DePoolFuncs := DePoolFuncs XTypesSig StateMonadSig.
Import DePoolFuncs.
Import DePoolSpec.
Import LedgerClass.

(* Import SolidityNotations. *)
Set Typeclasses Iterative Deepening.
Set Typeclasses Depth 100.
(*Set Typeclasses Strict Resolution. *)
(* Set Typeclasses Debug.  *)
(* Set Typeclasses Unique Instances.
Unset Typeclasses Unique Solutions. *)

(* Existing Instance monadStateT.
Existing Instance monadStateStateT. *)
(* Module MultiSigWalletSpecSig := MultiSigWalletSpecSig XTypesSig StateMonadSig. *)

Require Import depoolContract.Lib.CommonModelProofs.
Module CommonModelProofs := CommonModelProofs StateMonadSig.
Import CommonModelProofs.
Require Import depoolContract.Lib.Tactics.
Require Import depoolContract.Lib.ErrorValueProofs.
Require Import depoolContract.Lib.CommonCommon.
Require Import depoolContract.Lib.CommonStateProofs.

(* Require Import MultiSigWallet.Proofs.tvmFunctionsProofs. *)

Import DePoolSpec.LedgerClass.SolidityNotations.

Local Open Scope solidity_scope.

(* Require Import MultiSigWallet.Specifications._validatelimit_inlineSpec.
Module _validatelimit_inlineSpec := _validatelimit_inlineSpec MultiSigWalletSpecSig.
Import _validatelimit_inlineSpec. *)

Local Open Scope struct_scope.
Local Open Scope Z_scope.
Local Open Scope solidity_scope.
Require Import Lists.List.
Import ListNotations.
Local Open Scope list_scope.

(* Check hmapIsMember. *)

(* Lemma foo: forall (l: Ledger) addr, isSome
(eval_state
 (callEmbeddedStateAdj (H0 :=  FullState_T1xT2xT3xT4xT5xT6xT7xT8xT9xT10xT11xT12xT13xT14xT15xT16_T17)
 (DePoolFuncs.ParticipantBase_Ф_fetchParticipant
 addr)
 DePoolFuncs.DePoolSpec.LedgerClass.local0)
 l) =
isSome
(eval_state
 (callEmbeddedStateAdj (H0 :=  FullState_T1xT2xT3xT4xT5xT6xT7xT8xT9xT10xT11xT12xT13xT14xT15xT16_T17)
 (DePoolFuncs.ParticipantBase_Ф_fetchParticipant
 addr)
 DePoolFuncs.DePoolSpec.LedgerClass.local0)
 l).
 Proof.
    intros.
    reflexivity.
 Qed.    *)

(* Existing Instance embeddedLocalState.

Existing Instance monadStateT.
Existing Instance monadStateStateT. *)

(* Existing Instance embeddedLocalState.
Existing Instance embeddedMultisig. *)

 (* function ConfigParamsBase.getCurValidatorData (  )  virtual internal returns  ( uint256 hash ,  uint32 utime_since ,  uint32 utime_until )   {
         ( TvmCell cell ,  bool ok )  = tvm_rawConfigParam ( 34 )  ;
        require ( ok ,  InternalErrors . ERROR508 )  ;
        hash = tvm_hash ( cell )  ;
        TvmSlice s = cell . toSlice (  )  ;
         (  ,  utime_since ,  utime_until )  = s . decode ( uint8 ,  uint32 ,  uint32 )  ;
     }

Definition ConfigParamsBase_Ф_getCurValidatorData :  LedgerT ( XErrorValue ( XInteger256 # XInteger32 # XInteger32 ) XInteger ) :=
	U0! {( Л_cell , Л_ok )} := tvm_rawConfigParam (! $ xInt34 !) ;
 	Require {{ $ Л_ok , ↑ε8 InternalErrors_ι_ERROR508 }} ;
 	U0! Л_hash := tvm_hash (! $ Л_cell !) ;
 	U0! Л_s := ($ Л_cell) ->toSlice() ;
	U0! {( _ , Л_utime_since , Л_utime_until )} := ($ Л_s) ->decode(uint8,uint32,uint32) ;  (* (uint8 , uint32 , uint32) *)
	return# ( $Л_hash, $Л_utime_since , $Л_utime_until ).
*)

 Lemma ConfigParamsBase_Ф_getCurValidatorData_exec : forall (l: Ledger),
    exec_state (  ConfigParamsBase_Ф_getCurValidatorData ) l =  l.
 Proof.
   intros. destruct l. compute. auto.
 Qed.

 Lemma ConfigParamsBase_Ф_getCurValidatorData_eval : forall (l: Ledger) ,
 eval_state ( ConfigParamsBase_Ф_getCurValidatorData ) l =

 let (Л_cell, Л_ok) := eval_state (tvm_rawConfigParam 34) l in
 let hash := tvm_hash Л_cell in
 let sliceRaw := toSlice Л_cell in
 let res := decode_uint8_uint32_uint32 sliceRaw in
  if Л_ok then Value (hash , snd (fst (fst res)) , snd (fst res))
          else Error (eval_state ( ↑8 ε InternalErrors_ι_ERROR508) l).
 Proof.
   intros. destruct l. compute.  auto.
 Qed.

 (* function ConfigParamsBase.getPrevValidatorHash (  )  virtual internal returns  ( uint )   {
         ( TvmCell cell ,  bool ok )  = tvm_rawConfigParam ( 32 )  ;
        require ( ok ,  InternalErrors . ERROR507 )  ;
        return tvm_hash ( cell )  ;
     }

Definition ConfigParamsBase_Ф_getPrevValidatorHash : LedgerT ( XErrorValue XInteger XInteger ) :=
	U0! {( Л_cell , Л_ok )} := tvm_rawConfigParam (! $ xInt32 !) ;
 	Require {{ $ Л_ok , ↑ε8 InternalErrors_ι_ERROR507 }} ;
 	 tvm_hash (! $ Л_cell !).*)

 Lemma ConfigParamsBase_Ф_getPrevValidatorHash_exec : forall (l: Ledger) ,
 	 exec_state (  ConfigParamsBase_Ф_getPrevValidatorHash ) l = l .
 Proof.
   intros. destruct l. auto.
 Qed.

 Lemma ConfigParamsBase_Ф_getPrevValidatorHash_eval : forall (l: Ledger)  ,
 eval_state (  ConfigParamsBase_Ф_getPrevValidatorHash ) l =

 let (Л_cell, Л_ok) := eval_state (tvm_rawConfigParam 32) l in
 let hash := tvm_hash Л_cell in

 if Л_ok then Value hash
 else Error (eval_state ( ↑8 ε InternalErrors_ι_ERROR507) l).
 Proof.
   intros. compute. auto.
 Qed.

 (* function ConfigParamsBase.roundTimeParams (  )  virtual internal returns  (
        uint32 validatorsElectedFor ,
        uint32 electionsStartBefore ,
        uint32 electionsEndBefore ,
        uint32 stakeHeldFor
     )   {
        bool ok ;
         ( validatorsElectedFor ,  electionsStartBefore ,  electionsEndBefore ,  stakeHeldFor ,  ok )  = tvm_configParam ( 15 )  ;
        require ( ok ,  InternalErrors . ERROR509 )  ;
     }

Definition ConfigParamsBase_Ф_roundTimeParams  : LedgerT ( XErrorValue ( XInteger32 # XInteger32 # XInteger32 # XInteger32 ) XInteger )  :=
 U0! {( Л_validatorsElectedFor , Л_electionsStartBefore , Л_electionsEndBefore , Л_stakeHeldFor , Л_ok )} := tvm_configParam (! $ xInt15 !) ;
 Require {{ $ Л_ok , ↑ε8 InternalErrors_ι_ERROR509 }} ;
 return# ($Л_validatorsElectedFor, $Л_electionsStartBefore, $Л_electionsEndBefore, $Л_stakeHeldFor ).
*)
 Lemma ConfigParamsBase_Ф_roundTimeParams_exec : forall (l: Ledger) ,
 	 exec_state (  ConfigParamsBase_Ф_roundTimeParams ) l = l .
 Proof.
   intros. destruct l. auto.
 Qed.

 Lemma ConfigParamsBase_Ф_roundTimeParams_eval : forall (l: Ledger) ,
  eval_state ConfigParamsBase_Ф_roundTimeParams l =
  let (Л_params, Л_ок) := eval_state (tvm_configParam 15) l in
  let stakeHeldFor := snd Л_params in
  let electionsEndBefore := snd (fst Л_params) in
  let electionsStartBefore := snd (fst (fst Л_params)) in
  let validatorsElectedFor := fst (fst (fst Л_params)) in
   if Л_ок
    then
      Value (validatorsElectedFor,
            electionsStartBefore,
            electionsEndBefore,
            stakeHeldFor)
    else Error (eval_state ( ↑8 ε InternalErrors_ι_ERROR509) l).
 Proof.
   intros. destruct l.  compute. auto.
 Qed.

 (* function ConfigParamsBase.getMaxStakeFactor (  )  virtual pure internal returns  ( uint32 )   {
         ( TvmCell cell ,  bool ok )  = tvm_rawConfigParam ( 17 )  ;
        require ( ok ,  InternalErrors . ERROR516 )  ;
        TvmSlice s = cell . toSlice (  )  ;
        s . loadTons (  )  ;
        s . loadTons (  )  ;
        s . loadTons (  )  ;
        return s . decode ( uint32 )  ;
     }

Definition ConfigParamsBase_Ф_getMaxStakeFactor : LedgerT ( XErrorValue XInteger32 XInteger ) :=
	U0! {( Л_cell , Л_ok )} := tvm_rawConfigParam (! $ xInt17 !) ;
 	Require {{ $ Л_ok , ↑ε8 InternalErrors_ι_ERROR516 }} ;
 	U0! Л_s := ($ Л_cell) ->toSlice() ;
 	Л_s ->loadTons() ;
 	Л_s ->loadTons() ;
 	Л_s ->loadTons() ;
	($ Л_s) ->decode(uint32) . (*uint32*)
*)

 Lemma ConfigParamsBase_Ф_getMaxStakeFactor_exec : forall (l: Ledger) ,
 	 exec_state ConfigParamsBase_Ф_getMaxStakeFactor l = l .
 Proof.
   intros. destruct l. auto.
 Qed.

 Lemma ConfigParamsBase_Ф_getMaxStakeFactor_eval : forall (l: Ledger)  ,
 eval_state (  ConfigParamsBase_Ф_getMaxStakeFactor ) l =

 let (Л_cell, Л_ok) := eval_state (tvm_rawConfigParam 17) l in
 let sliceRaw := toSlice Л_cell in
 let t1 := tvm_loadTons (tvm_loadTons (tvm_loadTons sliceRaw)) in
 let res := fst (decode_uint32 t1) in
 if Л_ok
 then Value res
 else  Error (eval_state ( ↑8 ε InternalErrors_ι_ERROR516) l).
 Proof.
   intros. destruct l.
   compute. auto.
 Qed.

 (* function ConfigParamsBase.getElector (  )  virtual pure internal returns  ( address )   {
         ( TvmCell cell ,  bool ok )  = tvm_rawConfigParam ( 1 )  ;
        require ( ok ,  InternalErrors . ERROR517 )  ;
        TvmSlice s = cell . toSlice (  )  ;
        uint256 value = s . decode ( uint256 )  ;
        return address . makeAddrStd (  - 1 ,  value )  ;
     }

Definition ConfigParamsBase_Ф_getElector : LedgerT ( XErrorValue XAddress XInteger ) :=
 U0! {( Л_cell , Л_ok )} := tvm_rawConfigParam (! $ xInt1 !) ;
 Require {{ $ Л_ok , ↑ε8 InternalErrors_ι_ERROR517 }} ;
 U0! Л_s := ($ Л_cell) ->toSlice() ;
 U0! Л_value := ($ Л_s) ->decode(uint256) ;
  address->makeAddrStd (! $xInt0 !- $ xInt1 , $ Л_value !) .
*)

 Lemma ConfigParamsBase_Ф_getElector_exec : forall (l: Ledger) ,
 	 exec_state ConfigParamsBase_Ф_getElector l = l .
 Proof.
   intros. destruct l. auto.
 Qed.

 Lemma ConfigParamsBase_Ф_getElector_eval : forall (l: Ledger) ,
 eval_state  ConfigParamsBase_Ф_getElector l =

 let (Л_cell, Л_ok) := eval_state (tvm_rawConfigParam 1) l in

 let sliceRaw := toSlice Л_cell in
 let v := fst (decode_uint256 sliceRaw) in
 let res := address_makeAddrStd (-1)%Z v in

  if Л_ok then Value res
    else Error (eval_state ( ↑8 ε InternalErrors_ι_ERROR517) l).
 Proof.
  intros. destruct l.
  compute. auto.
 Qed.


(*
 * Module: Instructions
 *
 * Description:
 *  This module defines the various instructions that exist within the language.
 *)

Require Import TLB.
Require Import Arith.

(*
 * Inductive Type: tm
 *
 * Description:
 *   This data type represents all of the instructions that can occur in
 *   the language.  It also contains a "val" instruction which encapsulates
 *   data that can be stored in the store.
 *
 *   It's called "tm" because tm is short for "term" which is what the basic
 *   element of most small-step semantics are called.
 *
 *   This machine has a single register and has memory addressing modes.
 *
 *   val : Represents a value in memory
 *   sec : Represents a secret value in memory
 *   ldi : Load immediate value into register
 *   lda : Load value from specified address into register
 *   sta : Store value in register into specified address
 *   add : Add a constant value to the value in the register.  The result stays
 *         within the register.
 *   map : Add a TLB entry to the MMU.
 *   invalidate : Reset a TLB entry back to a default value.
 *   jmp : Jump to the address located in the register.
 *   jeq : Jump to the specified address if the register is zero.
 *   jne : Jump to the specified address if the register is negative.
 *   trap: Generate a machine trap (syscall, exception, or interrupt).
 *   iret: Return from a trap.
 *   svaDeclareStack : Declare a range of memory to be a stack.
 *   svaLoadPGTable : Load the ASID value
 *   svaInitStack   : Create and initialize a new thread
 *   svaSwap        : Switch to a new thread identified in the register
 *   svaRegisterTrap: Register a trap handler
 *   svaSaveIcontext: Save a copy of the interrupt context
 *   svaLoadIcontext: Save a copy of the interrupt context
 *   svaPushFunction: Push a function frame on to the interrupted stack
 *   jsr : Jump to the subroutine located in the register.
 *   ret : Return to the previously executed jsr instruction.
 *)
Inductive tm : Type :=
  | val  : nat -> tm
  | sec  : tm
  | ldi  : nat -> tm
  | lda  : nat -> tm
  | sta  : nat -> tm
  | add  : nat -> tm
  | sub  : nat -> tm
  | map  : nat -> TLBTy -> tm
  | jmp  : tm
  | jeq  : nat -> tm
  | jne  : nat -> tm
  | trap : tm
  | iret : tm
  | svaDeclareStack : nat -> nat -> tm
  | svaLoadPGTable : tm
  | svaInitStack : nat -> tm
  | svaSwap : tm
  | svaRegisterTrap : tm
  | svaSaveIcontext : tm
  | svaLoadIcontext : tm
  | svaPushFunction : nat -> tm
  | jsr : tm
  | ret : tm.


Require Import SetoidList ZArith Lia.
Require Import Flocq.Core.Zaux.
From compcert Require Import common.Errors backend.Cminor lib.Integers.
From sparkfrontend Require Import LibTac LibHypsNaming compcert_utils more_stdlib.
Import compcert.common.Memory.
Require compcert.cfrontend.Ctypes.

(*Require Import sparkfrontend.LibTac sparkfrontend.LibHypsNaming  compcert.common.Errors
        compcert.common.Cminor compcert.lib.Integers sparkfrontend.compcert_utils sparkfrontend.more_stdlib.*)

Open Scope nat_scope.
(** The Chaining structure of the stacks.

In this section we describe the way the first element of each local
stack points to another local stack up to a given depth. This give a
stack of stacks that is isomrphic to Spark's stack of stacks. *)

(* We need this structural invariant at least to prove that execution
   never modifies the chaining pointers. *)
Inductive chained_stack_structure m : nat -> Values.val -> Prop :=
| chained_0: forall b, chained_stack_structure m 0 (Values.Vptr b Ptrofs.zero) (* Should b null? *)
| chained_S: forall n b' b,
    chained_stack_structure m n (Values.Vptr b' Ptrofs.zero) ->
    Mem.loadv AST.Mint32 m (Values.Vptr b Ptrofs.zero) = Some (Values.Vptr b' Ptrofs.zero) ->
    chained_stack_structure m (S n) (Values.Vptr b Ptrofs.zero).

Inductive repeat_Mem_loadv (chk:AST.memory_chunk) (m : mem): forall (lvl:nat) (sp sp' : Values.val), Prop :=
| Repeat_loadv1: forall sp, repeat_Mem_loadv chk m O sp sp
| Repeat_loadv2: forall lvl sp sp' sp'',
    repeat_Mem_loadv chk m lvl sp' sp'' ->
    Mem.loadv AST.Mint32 m sp = Some sp' ->
    repeat_Mem_loadv chk m (S lvl) sp sp''.

(* CE gives the maximum number of loads. *)
Definition stack_localstack_aligned lvl locenv g m sp :=
  forall δ_lvl,
    (δ_lvl <= lvl)%nat ->
    exists b_δ,
      Cminor.eval_expr g sp locenv m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) δ_lvl) (Values.Vptr b_δ Ptrofs.zero).

Ltac rename_chained t th :=
  match th with
| chained_stack_structure ?m ?lvl ?sp => fresh "chain_" m "_" lvl "_" sp
| chained_stack_structure ?m ?lvl _ => fresh "chain_" m "_" lvl
| chained_stack_structure ?m _ _ => fresh "chain_" m
| chained_stack_structure _ ?lvl _ => fresh "chain_" lvl
| chained_stack_structure _ _ _ => fresh "chain"
| repeat_Mem_loadv _ ?m ?lvl ?v ?sp => fresh "repeat_loadv_" lvl "_" v
| repeat_Mem_loadv _ ?m ?lvl ?v ?sp => fresh "repeat_loadv_" lvl
| repeat_Mem_loadv _ ?m ?lvl ?v ?sp => fresh "repeat_loadv"
| stack_localstack_aligned _ _ ?g ?m ?sp => fresh "aligned_" g "_" m
| stack_localstack_aligned _ _ _ ?m ?sp => fresh "aligned_" m
| stack_localstack_aligned _ _ ?g _ ?sp => fresh "aligned_" g
end.

Ltac prefixable h th ::=
  match th with
  | _ => prefixable_compcert h th
  | _ => prefixable_eq_neq h th
  end.

Ltac rename_hyp h th ::=
  match th with
  | _ => (compcert_utils.rename_hyp1 h th)
  | _ => (LibHypsNaming.rename_hyp_neg h th)
  | _ => (rename_chained h th)
  end.

Lemma chained_stack_structure_le m sp : forall n,
    chained_stack_structure m n sp ->
    forall n', (n' <= n)%nat ->
               chained_stack_structure m n' sp.
Proof.
  !!intros ? ?.
  !induction h_chain_m_n_sp;!intros.
  - assert (n'=0)%nat by lia;subst.
    constructor.
  - destruct n'.
    * constructor.
    * econstructor;eauto.
      apply h_forall_n';eauto;lia.
Qed.

Lemma chained_stack_struct_inv_sp_zero: forall m n sp,
    chained_stack_structure m n sp -> exists b',  sp = (Values.Vptr b' Ptrofs.zero).
Proof.
  !intros.
  inversion h_chain_m_n_sp;subst;eauto.
Qed.

Lemma chained_stack_struct_sp_add: forall m n sp,
    chained_stack_structure m n sp -> (Values.Val.add sp (Values.Vint Int.zero)) = sp.
Proof.
  !intros.
  destruct (chained_stack_struct_inv_sp_zero m n sp);subst;auto.
Qed.

Lemma cm_eval_addrstack_zero:
  forall b ofs m g e,
      Cminor.eval_expr g (Values.Vptr b ofs) e m (Econst (Oaddrstack Ptrofs.zero)) (Values.Vptr b ofs).
Proof.
  !intros.
  constructor;cbn.
  rewrite Ptrofs.add_zero.
  reflexivity.
Qed.

Lemma cm_eval_addrstack_zero_chain:
  forall n sp m,
    chained_stack_structure m n sp ->
    forall g e,
      Cminor.eval_expr g sp e m (Econst (Oaddrstack Ptrofs.zero)) sp.
Proof.
  !intros.
  destruct (chained_stack_struct_inv_sp_zero _ _ _ h_chain_m_n_sp).
  subst.
  apply cm_eval_addrstack_zero.
Qed.

(* a useful formulation of the two previous lemmas. *)
Lemma det_cm_eval_addrstack_zero_chain : forall m lvl sp e g vaddr,
    chained_stack_structure m lvl sp ->
    Cminor.eval_expr g sp e m (Econst (Oaddrstack Ptrofs.zero)) vaddr ->
    vaddr = sp.
Proof.
  !intros.
  pose proof cm_eval_addrstack_zero_chain lvl sp m h_chain_m_lvl_sp g e.
  eapply det_eval_expr;eauto.
Qed.

Lemma det_cm_eval_addrstack_zero : forall b i m e g vaddr,
    Cminor.eval_expr g (Values.Vptr b i) e m (Econst (Oaddrstack Ptrofs.zero)) vaddr ->
    vaddr = (Values.Vptr b i).
Proof.
  !intros.
  pose proof cm_eval_addrstack_zero b i m g e.
  eapply det_eval_expr;eauto.
Qed.

Ltac subst_det_addrstack_zero :=

  match goal with
  | H:Cminor.eval_expr ?g ?sp ?e ?m ?exp ?vaddr,
      H':Cminor.eval_expr ?g ?sp ?e ?m ?exp ?vaddr' |- _ =>
    assert (vaddr=vaddr') by (eapply det_eval_expr;eauto);
    try (subst vaddr + subst vaddr');
    clear H
    (* to avoid useless applications *)
  | H:Cminor.eval_expr ?g ?sp ?e ?m ?exp ?sp |- _ =>
    fail 1
  | H:Cminor.eval_expr ?g (Values.Vptr ?b ?i) ?e ?m (Econst (Oaddrstack Ptrofs.zero)) ?vaddr |- _ =>
    assert (vaddr=(Values.Vptr b i)) by (eapply det_cm_eval_addrstack_zero;eauto);
    try subst vaddr
  | H:Cminor.eval_expr ?g ?sp ?e ?m (Econst (Oaddrstack Ptrofs.zero)) ?vaddr,
      H':chained_stack_structure ?m ?n ?sp |- _ =>
    assert (vaddr=sp) by (eapply det_cm_eval_addrstack_zero_chain;eauto);
    try subst vaddr

  end.

Lemma chained_stack_structure_aux m sp : forall n,
    chained_stack_structure m (S n) sp ->
    forall g e, exists b',
      chained_stack_structure m n (Values.Vptr b' Ptrofs.zero)
      /\ Mem.loadv AST.Mint32 m sp = Some (Values.Vptr b' Ptrofs.zero)
      /\ Cminor.eval_expr g sp e m (Eload AST.Mint32 (Econst (Oaddrstack Ptrofs.zero))) (Values.Vptr b' Ptrofs.zero).
Proof.
  !!intros until 1.
  inversion h_chain_m;subst;!intros.
  exists b';split;[|split];eauto.
  econstructor;eauto.
  constructor.
  cbn.
  reflexivity.
Qed.

Lemma build_loads__decomp_S: forall m b0 g e b,
    Cminor.eval_expr g (Values.Vptr b0 Ptrofs.zero) e m
                     (Eload AST.Mint32 (Econst (Oaddrstack Ptrofs.zero)))
                     (Values.Vptr b Ptrofs.zero) ->
    forall n v,
      Cminor.eval_expr g (Values.Vptr b0 Ptrofs.zero) e m
                       (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (S n)) v ->
      exists sp',
        Cminor.eval_expr g (Values.Vptr b0 Ptrofs.zero) e m
                         (Eload AST.Mint32 (Econst (Oaddrstack Ptrofs.zero))) sp'
        /\ Cminor.eval_expr g sp' e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) v.
Proof.
  !intros.
  revert v b h_CM_eval_expr h_CM_eval_expr_v.
  !induction n.
  - !intros.
    cbn in *.
    exists v;split;auto.
    constructor;cbn.
    subst_det_addrstack_zero.
    cbn.
    rewrite Ptrofs.add_zero.
    reflexivity.
  - !intros.
    cbn in h_CM_eval_expr_v.
    !invclear h_CM_eval_expr_v;subst.
    change (Eload AST.Mint32 (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) with (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (S n)) in h_CM_eval_expr_vaddr.
    specialize (h_forall_v _ _ h_CM_eval_expr h_CM_eval_expr_vaddr).
    decomp h_forall_v.
    exists sp';split;auto.
    cbn.
    econstructor;eauto.
Qed.

Lemma chained_stack_structure_decomp_S: forall m max sp g e,
    forall n v, chained_stack_structure m max sp ->
      n < max ->
      Cminor.eval_expr g sp e m
                       (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (S n))
                       v ->
         exists sp',
           Cminor.eval_expr g sp e m (Eload AST.Mint32 (Econst (Oaddrstack Ptrofs.zero))) sp' /\
           Cminor.eval_expr g sp' e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) v.
Proof.
  !!intros until n.
  !induction n.
  - !intros.
    cbn in *.
    exists v;split;auto.
    eapply cm_eval_addrstack_zero_chain with (n:=Nat.pred max);eauto.
    rewrite <- (PeanoNat.Nat.succ_pred_pos _ h_lt_O_max) in h_chain_m_max_sp.
    !inversion h_chain_m_max_sp.
    !inversion h_CM_eval_expr_v.
    subst_det_addrstack_zero.
    rewrite h_loadv in h_loadv_vaddr_v.
    inversion h_loadv_vaddr_v.
    assumption.
  - !intros.
    cbn in h_CM_eval_expr_v.
    !invclear h_CM_eval_expr_v;subst.
    change (Eload AST.Mint32 (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) with (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (S n)) in h_CM_eval_expr_vaddr.
    !!assert (n<max) by lia.
    specialize h_forall_v with (1:=h_chain_m_max_sp)(2:=h_lt_n_max)(3:=h_CM_eval_expr_vaddr).
    decomp h_forall_v.
    exists sp';split;auto.
    cbn.
    econstructor;eauto.
Qed.

Lemma chained_stack_structure_spec :
  forall  g e m n b,
    (forall lvl,
        (lvl <= n)%nat
        -> exists b',
          Cminor.eval_expr g (Values.Vptr b Ptrofs.zero) e m
                           (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) lvl)
                           (Values.Vptr b' Ptrofs.zero))
    -> chained_stack_structure m n (Values.Vptr b Ptrofs.zero).
Proof.
  !!induction n;!intros.
  - constructor.
  - !!assert (1 <= S n) by lia.
    !!pose proof  (h_forall_lvl 1%nat h_le).
    decomp h_ex.
    !!assert (S n <= S n) by lia.
    !!pose proof  (h_forall_lvl _ h_le0).
    decomp h_ex.
    cbn in *.
    !!specialize build_loads__decomp_S with (1:=h_CM_eval_expr)(2:=h_CM_eval_expr0) as ?.
    decomp h_ex.
    subst_det_addrstack_zero.
    eapply chained_S with (b':=b');eauto.
    + eapply h_forall_b.
      !intros.
      !!assert (S lvl <= S n) by lia.
      !!pose proof  (h_forall_lvl _ h_le1).
      decomp h_ex.
      cbn in *.
      !!specialize build_loads__decomp_S with (1:=h_CM_eval_expr_sp') (2:=h_CM_eval_expr) as ?.
      decomp h_ex.
      subst_det_addrstack_zero.
      eauto.
    + !inversion h_CM_eval_expr_sp'.
      subst_det_addrstack_zero.
      assumption.
Qed.

Lemma assignment_preserve_chained_stack_structure_aux:
  forall stkptr m chk e_t_v addr_blck addr_ofs m' n,
    chained_stack_structure m n stkptr ->
    (4 <= (Ptrofs.unsigned addr_ofs))%Z ->
    Mem.storev chk m (Values.Vptr addr_blck addr_ofs) e_t_v = Some m' ->
    chained_stack_structure m' n stkptr.
Proof.
  !intros.
  induction h_chain_m_n_stkptr.
  - constructor.
  - econstructor.
    all:swap 1 2.
    + unfold Mem.loadv.
      unfold Mem.storev in heq_storev_e_t_v_m'.
      erewrite Mem.load_store_other with (m1:=m);eauto.
    + assumption.
Qed.

(*
Lemma add_Vint_zero: forall m vaddr x,
    Mem.loadv AST.Mint32 m vaddr = Some x ->
    Values.Val.add x (Values.Vint Int.zero) = x.
Proof.
  !intros.
  destruct vaddr;cbn in *; try discriminate.
  cbn.
Qed.
 *)

Lemma chained_stack_structure_decomp_S_2': forall n m sp,
    chained_stack_structure m (S n) sp ->
    forall g e v sp',
      Cminor.eval_expr g sp e m (Eload AST.Mint32 (Econst (Oaddrstack Ptrofs.zero))) sp' ->
      Cminor.eval_expr g sp' e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) v ->
      Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (S n)) v.
Proof.
  intro n.
  !induction n.
  - !intros.
    cbn in *.
    !inversion h_CM_eval_expr_sp'.
    !inversion h_CM_eval_expr_vaddr.
    !inversion h_CM_eval_expr_v.
    cbn in *.
    !invclear h_eval_constant.
    !invclear h_eval_constant0;subst.
    assert (exists b, sp' = Values.Vptr b Ptrofs.zero).
    { !inversion h_chain_m.
      cbn in *.
      rewrite Ptrofs.add_zero in h_loadv_vaddr_sp'.
      rewrite h_loadv_vaddr_sp' in h_loadv.
      inversion h_loadv.
      eauto. }
    decomp H;subst.
    econstructor;cbn;eauto.
  - !intros.
    cbn in h_CM_eval_expr_v.
    cbn.
    inversion h_CM_eval_expr_v;subst.
    econstructor;eauto.
    eapply h_forall_m;eauto.
    eapply chained_stack_structure_le;eauto.
Qed.

Lemma chain_structure_spec:
  forall n m sp ,
    chained_stack_structure m n sp ->
    forall g e,
      exists b, Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) (Values.Vptr b Ptrofs.zero).
Proof.
  !!intros until 1.
  !induction h_chain_m_n_sp;!intros.
  - exists b.
    eapply cm_eval_addrstack_zero;eauto.
  - specialize (h_forall_g g e).
    decomp h_forall_g.
    exists b0.
    eapply chained_stack_structure_decomp_S_2';eauto.
    + econstructor;eauto.
    + econstructor;eauto.
      constructor.
      reflexivity.
Qed.

Lemma chain_repeat_loadv_1 : forall m n sp,
    chained_stack_structure m n sp ->
    forall v g e, repeat_Mem_loadv AST.Mint32 m n sp v ->
                  Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) v.
Proof.
  !!intros until 1.
  !induction h_chain_m_n_sp;cbn;!intros.
  - !inversion h_repeat_loadv_O.
    apply cm_eval_addrstack_zero.
  - eapply chained_stack_structure_decomp_S_2'.
    + econstructor;eauto.
    + econstructor;eauto.
      econstructor;eauto.
    + eapply h_forall_v;eauto.
      !inversion h_repeat_loadv.
      rewrite h_loadv in h_loadv_sp'.
      !invclear h_loadv_sp'.
      assumption.
Qed.

Lemma chained_stack_structure_decomp_S_2: forall n m sp,
    chained_stack_structure m (S n) sp ->
    forall g e v,
      Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (S n)) v ->
      exists sp',
        Cminor.eval_expr g sp e m (Eload AST.Mint32 (Econst (Oaddrstack Ptrofs.zero))) sp' /\
        Cminor.eval_expr g sp' e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) v.
Proof.
  intro n.
  !induction n.
  - !intros.
    cbn in *.
    exists v;split;auto.
    constructor;cbn.
    !!pose proof chained_stack_structure_aux _ _ _ h_chain_m g e.
    decomp h_ex.
    subst_det_addrstack_zero.
    cbn.
    rewrite Ptrofs.add_zero.
    reflexivity.
  - !intros.
    cbn in h_CM_eval_expr_v.
    !inversion h_CM_eval_expr_v;subst.
    change (Eload AST.Mint32 (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) with (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (S n)) in h_CM_eval_expr_vaddr.
    !assert (chained_stack_structure m (S n) sp).
    { eapply chained_stack_structure_le;eauto. }
    specialize h_forall_m with (1:=h_chain_m0) (2:=h_CM_eval_expr_vaddr).
    decomp h_forall_m.
    exists sp';split;auto.
    cbn.
    econstructor;eauto.
Qed.

(* We can cut a chain into a smaller chain. *)
Lemma chain_structure_cut:
  forall n'' n' m sp ,
    chained_stack_structure m (n'+n'') sp ->
    forall g e,
      exists v sp' : Values.val,
        Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (n'+n'')%nat) v
        /\ Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n'') sp'
        /\ Cminor.eval_expr g sp' e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n') v
        /\ chained_stack_structure m n' sp'.
Proof.
  !!intros * ? *.
  !!pose proof chain_structure_spec _ _ _ h_chain_m g e.
  decomp h_ex.
  exists (Values.Vptr b Ptrofs.zero).
  revert dependent h_CM_eval_expr.
  revert dependent h_chain_m.
  revert n' m sp g e b.
  !induction n'';!intros;up_type.
  - replace (n'+0)%nat with n' in * by lia.
    exists sp;split;[eauto| split;eauto].
    cbn.
    eapply cm_eval_addrstack_zero_chain;eauto.
  - specialize (h_forall_n' (S n') m sp g e b).
    !assert (chained_stack_structure m (S n' + n'') sp).
    { replace (n' + S n'')%nat with (S n' + n'')%nat in h_chain_m; try lia.
      assumption. }
    specialize (h_forall_n' h_chain_m0).
    replace (n' + S n'')%nat with (S n' + n'')%nat in h_CM_eval_expr; try lia.
    specialize (h_forall_n' h_CM_eval_expr).
    decomp h_forall_n'.
    !specialize chained_stack_structure_decomp_S_2 with (1:=h_chain_m1)(2:=h_CM_eval_expr1) as ?.
    decomp h_ex.
    exists sp'0;split;[|split;[|split]];eauto.
    + replace (n' + S n'')%nat with (S n' + n'')%nat; try lia.
      assumption.
    + cbn.
      econstructor.
      * eassumption.
      * !inversion h_CM_eval_expr_sp'0.
        repeat subst_det_addrstack_zero.
        assumption.
    + !inversion h_CM_eval_expr_sp'0;subst.
      repeat subst_det_addrstack_zero.
      clear h_chain_m h_chain_m0.
      !inversion h_chain_m1;subst;up_type.
      cbn in *.
      rewrite h_loadv in h_loadv_vaddr_sp'0.
      inversion h_loadv_vaddr_sp'0.
      subst.
      assumption.
Qed.

Lemma chained_stack_structure_decomp_S_3: forall n m sp n_base,
    chained_stack_structure m (S n + n_base) sp ->
    let base := (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n_base) in
    forall g e v,
      Cminor.eval_expr g sp e m (build_loads_ base (S n)) v ->
      exists sp',
        Cminor.eval_expr g sp e m (Eload AST.Mint32 (Econst (Oaddrstack Ptrofs.zero))) sp' /\
        Cminor.eval_expr g sp' e m (build_loads_ base n) v.
Proof.
  !intros.
  unfold base in h_CM_eval_expr_v.
  rewrite <- build_loads_compos in h_CM_eval_expr_v.
  cbn [plus] in h_CM_eval_expr_v.
  !!pose proof chained_stack_structure_decomp_S_2 _ _ _ h_chain_m g e v h_CM_eval_expr_v.
  decomp h_ex.
  exists sp';split;eauto.
  unfold base.
  rewrite <- build_loads_compos_comm.
  rewrite Nat.add_comm.
  assumption.
Qed.

Lemma chained_stack_structure_decomp_add: forall n1 n2 m sp,
    chained_stack_structure m (n1 + n2) sp ->
    forall g e v,
      Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (n1 + n2)) v ->
      exists sp',
        Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n2) sp' /\
        Cminor.eval_expr g sp' e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n1) v.
Proof.
  !!intros until e.
  specialize chain_structure_cut with (1:=h_chain_m)(g:=g)(e:=e) as h.
  decomp h.
  !intros.
  subst_det_addrstack_zero.
  exists sp'.
  split;auto.
Qed.

Lemma chained_stack_structure_decomp_add': forall n1 n2 m sp sp' g e v,
    chained_stack_structure m (n1 + n2) sp ->
    Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n2) sp' ->
    Cminor.eval_expr g sp' e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n1) v ->
    Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) (n1 + n2)) v.
Proof.
  !!intros until 1.
  specialize chain_structure_cut with (1:=h_chain_m)(g:=g)(e:=e) as h.
  decomp h.
  !intros.
  repeat subst_det_addrstack_zero.
  assumption.
Qed.

Lemma chain_repeat_loadv_2: forall (m : mem) (n : nat) (sp : Values.val),
    chained_stack_structure m n sp
    -> forall (v : Values.val) (g : genv) (e : env),
      eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) v
      -> repeat_Mem_loadv AST.Mint32 m n sp v.
Proof.
  !!intros until 1.
  !induction h_chain_m_n_sp;!intros.
  - !inversion h_CM_eval_expr_v.
    inversion h_eval_constant.
    rewrite Ptrofs.add_zero_l.
    constructor.
  - assert (chained_stack_structure m (S n) (Values.Vptr b Ptrofs.zero)) by (econstructor;eauto).
    econstructor 2.
    all:swap 1 2.
    + eassumption.
    + eapply h_forall_v with (g:=g)(e:=e).
      cbn in h_CM_eval_expr_v.
      specialize chained_stack_structure_decomp_S_2 with (1:=H)(2:=h_CM_eval_expr_v) as h.
      decomp h.
      !assert ((Values.Vptr b' Ptrofs.zero) = sp').
      { clear h_CM_eval_expr_v0.
        !inversion h_CM_eval_expr_sp';subst.
        !inversion h_CM_eval_expr_vaddr.
        cbn in h_eval_constant.
        rewrite Ptrofs.add_zero_l in h_eval_constant.
        inversion h_eval_constant.
        subst.
        rewrite h_loadv in h_loadv_vaddr_sp'.
        inversion h_loadv_vaddr_sp'.
        auto. }
      rewrite heq_vptr_b'_zero.
      assumption.
Qed.

Lemma chain_repeat_loadv: forall (m : mem) (n : nat) (sp : Values.val),
    chained_stack_structure m n sp
    -> forall (v : Values.val) (g : genv) (e : env),
      repeat_Mem_loadv AST.Mint32 m n sp v
      <-> eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) v.
Proof.
  split.
  - apply chain_repeat_loadv_1;auto.
  - apply chain_repeat_loadv_2;auto.
Qed.

Lemma chain_struct_build_loads_ofs : forall  m n sp_init,
    chained_stack_structure m n sp_init ->
    forall δ_var g e b ofs,
      (δ_var mod Ptrofs.modulus)%Z = δ_var ->
      Cminor.eval_expr g sp_init e m (build_loads n δ_var) (Values.Vptr b ofs) ->
      ofs = Ptrofs.repr δ_var.
Proof.
  !intros.
  !!pose proof chained_stack_struct_inv_sp_zero _ _ _ h_chain_m_n_sp_init.
  decomp h_ex;subst.
  unfold build_loads in h_CM_eval_expr;cbn.
  !invclear h_CM_eval_expr.
  !inversion h_CM_eval_expr_v2;subst;cbn in *.
  !invclear h_eval_binop_Oadd_v1_v2.
  !invclear h_eval_constant.
  replace n with (0+n)%nat in h_CM_eval_expr_v1,h_chain_m_n_sp_init by auto with arith.
  !!pose proof chain_structure_cut _ _ _ _ h_chain_m_n_sp_init g e.
  decomp h_ex.
  replace (0+n)%nat with n in h_CM_eval_expr_v1,h_chain_m_n_sp_init by auto with arith.
  subst_det_addrstack_zero.
  !!pose proof chained_stack_struct_inv_sp_zero _ _ _ h_chain_m_O_sp'.
  decomp h_ex.
  subst.
  cbn in h_val_add_v1_v2.
  rewrite Ptrofs.add_zero_l in h_val_add_v1_v2.
  destruct Archi.ptr64.
  - inversion h_val_add_v1_v2.
  - !inversion h_val_add_v1_v2.
    unfold Ptrofs.of_int.
    rewrite Int.unsigned_repr_eq.
    apply f_equal;auto.
Qed.

Lemma malloc_preserves_chained_structure :
  forall lvl m sp b ofs  m' new_sp,
    Mem.alloc m b ofs = (m', new_sp) ->
    chained_stack_structure m lvl sp ->
    chained_stack_structure m' lvl sp.
Proof.
  intro lvl.
  !induction lvl;!intros.
  - !inversion h_chain_m_O_sp.
    constructor.
  - !inversion h_chain_m.
    cbn in *.
    econstructor.
    + eapply h_forall_m;eauto.
    + cbn.
      eapply Mem.load_alloc_other;eauto.
Qed.

Lemma malloc_preserves_chaining_loads :
  forall m lvl sp sz m' new_sp,
    Mem.alloc m 0 sz = (m', new_sp) ->
    forall n, (n <= lvl)%nat ->
         chained_stack_structure m lvl sp ->
         forall e g sp',
           Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) sp'
           -> Cminor.eval_expr g sp e m' (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) sp'.
Proof.
  !!intros until n.
  induction n;!intros.
  - cbn in *.
    !!pose proof chained_stack_struct_inv_sp_zero _ _ _ h_chain_m_lvl_sp.
    decomp h_ex.
    subst.
    subst_det_addrstack_zero.
    apply cm_eval_addrstack_zero.
  - !!assert (n <= lvl)%nat by lia.
    specialize (IHn h_le_n_lvl h_chain_m_lvl_sp).
    cbn -[Mem.storev] in *.
    !inversion h_CM_eval_expr_sp'.
    specialize (IHn _ _ _ h_CM_eval_expr_vaddr).
    econstructor.
    + eassumption.
    + cbn in *.
      rewrite <- h_loadv_vaddr_sp'.
      destruct vaddr; try discriminate.
      cbn in *.
      eapply Mem.load_alloc_unchanged;eauto.
      eapply Mem.valid_access_valid_block.
      apply Mem.load_valid_access in h_loadv_vaddr_sp'.
      eapply Mem.valid_access_implies with (1:=h_loadv_vaddr_sp').
      constructor.
Qed.

Lemma malloc_preserves_chaining_loads_2 :
  forall m lvl sp sz m' new_sp,
    Mem.alloc m 0 sz = (m', new_sp) ->
    forall n, (n <= lvl)%nat ->
         chained_stack_structure m lvl sp ->
         forall e g sp',
           Cminor.eval_expr g sp e m' (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) sp'
           -> Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) sp'.
Proof.
  !!intros until n.
  induction n;!intros.
  - cbn in *.
    !!pose proof chained_stack_struct_inv_sp_zero _ _ _ h_chain_m_lvl_sp.
    decomp h_ex.
    subst.
    subst_det_addrstack_zero.
    apply cm_eval_addrstack_zero.
  - !!assert (n <= lvl)%nat by lia.
    specialize (IHn h_le_n_lvl h_chain_m_lvl_sp).
    cbn -[Mem.storev] in *.
    !inversion h_CM_eval_expr_sp'.
    specialize (IHn _ _ _ h_CM_eval_expr_vaddr).
    econstructor.
    + eassumption.
    + cbn in *.
      rewrite <- h_loadv_vaddr_sp'.
      destruct vaddr; try discriminate.
      cbn in *.
      symmetry.
      eapply Mem.load_alloc_unchanged;eauto.
      destruct (Mem.valid_block_alloc_inv _ _ _ _ _ h_malloc_m_m' b).
      * eapply Mem.valid_access_valid_block.
        apply Mem.load_valid_access in h_loadv_vaddr_sp'.
        eapply Mem.valid_access_implies with (1:=h_loadv_vaddr_sp').
        constructor.
      * exfalso.
        subst.
        !!assert ((lvl-n) + n = lvl)%nat by lia.
        rewrite <- heq_add in h_chain_m_lvl_sp.
        !!pose proof (chain_structure_cut _ _ _ _ h_chain_m_lvl_sp) g e.
        decomp h_ex.
        rewrite heq_add in h_CM_eval_expr_v.
        subst_det_addrstack_zero.
        destruct (lvl - n)%nat eqn:heq'.
        -- exfalso; lia.
        -- cbn in h_CM_eval_expr_v0.
           eapply chained_stack_structure_decomp_S_2 in h_CM_eval_expr_v0.
           ++ decomp h_CM_eval_expr_v0.
              !inversion h_CM_eval_expr_sp'0.
              subst_det_addrstack_zero.
              absurd (Mem.valid_block m new_sp).
              ** eapply Mem.fresh_block_alloc;eauto.
              ** unfold Mem.loadv in h_loadv_vaddr_sp'0.
                 eapply  Mem.load_valid_access in h_loadv_vaddr_sp'0.
                 eapply Mem.valid_access_valid_block.
                 eapply Mem.valid_access_implies;eauto.
                 constructor.
           ++ assumption.
      * assumption.
Qed.

Lemma malloc_distinct_from_chaining_loads :
  forall lvl m sp,
    chained_stack_structure m lvl sp ->
    forall n sz m' new_sp,
      Mem.alloc m 0 sz = (m', new_sp) ->
      forall e g, (n < lvl)%nat -> forall b' ,
          Cminor.eval_expr g sp e m
                           ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) (Values.Vptr b' Ptrofs.zero)
          -> b' <> new_sp.
Proof.
  !!intros * ?.
  !induction h_chain_m_lvl_sp;cbn;!intros.
  - exfalso;lia.
  - destruct n0.
    + cbn in *.
      !!subst_det_addrstack_zero.
      !invclear H.
      intro abs;subst b.
      !!pose proof Mem.load_valid_access _ _ _ _ _ h_loadv.
      !!pose proof Mem.fresh_block_alloc _ _ _ _ _ h_malloc_m_m'.
      apply h_neg_valid_blck_m_new_sp.
      eapply Mem.valid_access_valid_block.
      eapply Mem.valid_access_implies with (1:=h_valid_access_new_sp).
      constructor.
    + eapply h_forall_n with (n0:=n0);eauto.
      * lia.
      * !assert(chained_stack_structure m (S n) (Values.Vptr b Ptrofs.zero)).
        { econstructor;eauto. }
        !assert(chained_stack_structure m (S n0) (Values.Vptr b Ptrofs.zero)).
        { eapply chained_stack_structure_le with (n:=S n).
          - assumption.
          - lia. }
        !!pose proof chained_stack_structure_decomp_S_2 _ _ _ h_chain_m0 g e _ h_CM_eval_expr.
        decomp h_ex.
        !inversion h_CM_eval_expr_sp'.
        subst_det_addrstack_zero.
        subst.
        rewrite h_loadv in h_loadv_vaddr_sp'.
        inversion h_loadv_vaddr_sp'.
        subst.
        eassumption.
Qed.

(* if we store in a block [sp0] not invovlved in the chaining from [sp], then
   all chainging addresses reachable from sp from sp'' are unchanged. *)
Lemma chain_aligned: forall m n stkptr,
  chained_stack_structure m n stkptr ->
  forall lgth_CE,
    (lgth_CE <= n)%nat ->
    forall locenv g,
      stack_localstack_aligned lgth_CE locenv g m stkptr.
Proof.
  !!intros until 1.
  unfold stack_localstack_aligned.
  !induction h_chain_m_n_stkptr;!intros.
  - exists b.
    assert (δ_lvl = 0%nat) by lia;subst.
    cbn.
    apply cm_eval_addrstack_zero.
  - destruct δ_lvl.
    + cbn.
      exists b.
      apply cm_eval_addrstack_zero.
    + cbn.
      !!destruct lgth_CE;[cbn in h_le_δ_lvl_lgth_CE;exfalso;lia|].
      subst;up_type.
      specialize (h_forall_lgth_CE lgth_CE).
      !!assert (lgth_CE <= n) by lia.
      !!assert (δ_lvl <= lgth_CE)%nat by lia.
      specialize (fun locenv g => h_forall_lgth_CE h_le_lgth_CE_n locenv g δ_lvl h_le_δ_lvl_lgth_CE0).
      specialize (h_forall_lgth_CE locenv g).
      decomp h_forall_lgth_CE.
      exists b_δ.
      assert (chained_stack_structure m (S δ_lvl) (Values.Vptr b Ptrofs.zero)).
      { econstructor; eauto.
        eapply chained_stack_structure_le;eauto.
        lia. }
      eapply chained_stack_structure_decomp_S_2';eauto.
      econstructor;eauto.
      eapply cm_eval_addrstack_zero_chain;eauto.
Qed.

Lemma storev_outside_struct_chain_preserves_chaining:
  forall sp0 e sp g m lvl,
      (* chainging addresses are unchanged. *)
      (forall n, (n < lvl)%nat -> forall b' ,
            Cminor.eval_expr g sp e m
                             ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) (Values.Vptr b' Ptrofs.zero)
            -> b' <> sp0) ->
      forall n, chained_stack_structure m lvl sp ->
           forall x _v _chk m', Mem.storev _chk m (Values.Vptr sp0 _v) x = Some m' ->
                   (n <= lvl)%nat -> forall v,
                       Cminor.eval_expr g sp e m ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) v
                       -> Cminor.eval_expr g sp e m' ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) v.
Proof.
  !!intros until lvl.
  intros h_eval_sp_lds n.
  !induction n;!intros.
  - cbn in *.
    !!pose proof chained_stack_struct_inv_sp_zero _ _ _ h_chain_m_lvl_sp.
    decomp h_ex.
    subst.
    subst_det_addrstack_zero.
    apply cm_eval_addrstack_zero.
  - !!assert (n <= lvl)%nat by lia.
    specialize (h_impl_forall_x h_chain_m_lvl_sp _ _ _ _ heq_storev_x_m' h_le_n_lvl).
    cbn -[Mem.storev] in *.
    !inversion h_CM_eval_expr_v.
    specialize (h_impl_forall_x _ h_CM_eval_expr_vaddr).
    econstructor.
    + eassumption.
    + cbn in *.
      destruct vaddr; try discriminate.
      cbn in *.
      pose proof Mem.load_store_other _ _ _ _ _ _ heq_storev_x_m' AST.Mint32 b (Ptrofs.unsigned i) as h.
      rewrite h.
      * assumption.
      * left.
        eapply h_eval_sp_lds with (n:=n).
        -- lia.
        -- assert (i = Ptrofs.zero).
           { !!pose proof chain_aligned _ _ _ h_chain_m_lvl_sp lvl (le_n _) e g.
             red in h_aligned_g_m.
             !!assert (n <= lvl) by lia.
             specialize (h_aligned_g_m _ h_le_n_lvl0).
             decomp h_aligned_g_m.
             !! (subst_det_addrstack_zero;idtac).
             inversion heq_vptr_b_i.
             reflexivity. }
           subst.
           eassumption.
Qed.

(* more general result: we can change something in the chained
structure but not the structure itself (chainging pointers. *)
Lemma gen_storev_outside_struct_chain_preserves_chaining:
  forall sp0 e sp g m lvl ofs0,
    (* chainging addresses are unchanged. *)
    ((4 <= (Ptrofs.unsigned ofs0))%Z \/
    (forall n, (n < lvl)%nat -> forall b' ,
          Cminor.eval_expr
            g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)
            (Values.Vptr b' Ptrofs.zero)
          -> b' <> sp0)) ->
    forall n, chained_stack_structure m lvl sp ->
              forall x _chk m', Mem.storev _chk m (Values.Vptr sp0 ofs0) x = Some m' ->
                                (n <= lvl)%nat -> forall v,
                                    Cminor.eval_expr g sp e m ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) v
                                    -> Cminor.eval_expr g sp e m' ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) v.
Proof.
  !!intros until ofs0.
  intros h_eval_sp_lds n.
  !induction n;!intros.
  - cbn in *.
    !!pose proof chained_stack_struct_inv_sp_zero _ _ _ h_chain_m_lvl_sp.
    decomp h_ex.
    subst.
    subst_det_addrstack_zero.
    apply cm_eval_addrstack_zero.
  - !!assert (n <= lvl)%nat by lia.
    specialize h_impl_forall_x with (1:=h_chain_m_lvl_sp)(2:=heq_storev_x_m') (3:=h_le_n_lvl).
    cbn -[Mem.storev] in *.
    !inversion h_CM_eval_expr_v.
    specialize (h_impl_forall_x _ h_CM_eval_expr_vaddr).
    econstructor.
    + eassumption.
    + cbn in *.
      destruct vaddr; try discriminate.
      cbn in *.
      pose proof Mem.load_store_other _ _ _ _ _ _ heq_storev_x_m' AST.Mint32 b (Ptrofs.unsigned i) as h.
      rewrite h.
      * assumption.
      * !destruct h_eval_sp_lds.
        -- right.
           assert (i = Ptrofs.zero).
           { !!specialize chained_stack_structure_le with (1:=h_chain_m_lvl_sp) (2:=h_le_n_lvl) as ?.
             !!specialize chain_structure_spec with (1:=h_chain_m_n_sp) (g:=g)(e:=e) as ?.
             decomp h_ex.
             !!specialize det_eval_expr with (1:=h_CM_eval_expr) (2:=h_CM_eval_expr_vaddr) as ?.
             !inversion heq_vptr_b0_zero.
             reflexivity. }
           subst.
           left.
           cbn.
           rewrite Ptrofs.unsigned_zero.
           lia.
        -- left.
           eapply h_forall_n with (n:=n).
           ++ lia.
           ++ assert (i = Ptrofs.zero).
              { !!pose proof chain_aligned _ _ _ h_chain_m_lvl_sp lvl (le_n _) e g.
                red in h_aligned_g_m.
                !!assert (n <= lvl) by lia.
                specialize (h_aligned_g_m _ h_le_n_lvl0).
                decomp h_aligned_g_m.
                !! (subst_det_addrstack_zero;idtac).
                inversion heq_vptr_b_i.
                reflexivity. }
              subst.
              eassumption.
Qed.

Lemma storev_outside_struct_chain_preserves_chaining2:
  forall sp0 e sp g m lvl,
      (* chainging addresses are unchanged. *)
      (forall n, (n < lvl)%nat -> forall b' ,
            Cminor.eval_expr g sp e m
                             ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) (Values.Vptr b' Ptrofs.zero)
            -> b' <> sp0) ->
      forall n, chained_stack_structure m lvl sp ->
           forall x _v _chk m', Mem.storev _chk m (Values.Vptr sp0 _v) x = Some m' ->
                   (n <= lvl)%nat -> forall v,
                       Cminor.eval_expr g sp e m' ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) v
                       -> Cminor.eval_expr g sp e m ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) v.
Proof.
  !!intros until lvl.
  intros h_eval_sp_lds n.
  !induction n;!intros.
  - cbn in *.
    !!pose proof chained_stack_struct_inv_sp_zero _ _ _ h_chain_m_lvl_sp.
    decomp h_ex.
    subst.
    subst_det_addrstack_zero.
    apply cm_eval_addrstack_zero.
  - !!assert (n <= lvl)%nat by lia.
    specialize (h_impl_forall_x h_chain_m_lvl_sp _ _ _ _ heq_storev_x_m' h_le_n_lvl).
    cbn -[Mem.storev] in *.
    !inversion h_CM_eval_expr_v.
    specialize (h_impl_forall_x _ h_CM_eval_expr_vaddr).
    econstructor.
    + eassumption.
    + cbn in *.
      destruct vaddr; try discriminate.
      cbn in *.
      pose proof Mem.load_store_other _ _ _ _ _ _ heq_storev_x_m' AST.Mint32 b (Ptrofs.unsigned i) as h.
      rewrite <- h.
      * assumption.
      * left.
        eapply h_eval_sp_lds with (n:=n).
        -- lia.
        -- assert (i = Ptrofs.zero).
           { !!pose proof chain_aligned _ _ _ h_chain_m_lvl_sp lvl (le_n _) e g.
             red in h_aligned_g_m.
             !!assert (n <= lvl) by lia.
             specialize (h_aligned_g_m _ h_le_n_lvl0).
             decomp h_aligned_g_m.
             !! (subst_det_addrstack_zero;idtac).
             inversion heq_vptr_b_δ_zero.
             reflexivity. }
           subst.
           eassumption.
Qed.

(* More general result *)
Lemma gen_storev_outside_struct_chain_preserves_chaining2:
  forall sp0 e sp g m lvl ofs0,
    (* chainging addresses are unchanged. *)
    ((4 <= (Ptrofs.unsigned ofs0))%Z \/
     forall n, (n < lvl)%nat -> forall b' ,
         Cminor.eval_expr g sp e m
                          ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) (Values.Vptr b' Ptrofs.zero)
         -> b' <> sp0) ->
    forall n, chained_stack_structure m lvl sp ->
              forall x _chk m', Mem.storev _chk m (Values.Vptr sp0 ofs0) x = Some m' ->
                                   (n <= lvl)%nat -> forall v,
                                       Cminor.eval_expr g sp e m' ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) v
                                       -> Cminor.eval_expr g sp e m ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) v.
Proof.
  !!intros until ofs0.
  intros h_eval_sp_lds n.
  !induction n;!intros.
  - cbn in *.
    !!specialize chained_stack_struct_inv_sp_zero with (1:=h_chain_m_lvl_sp) as ?.
    decomp h_ex.
    subst.
    subst_det_addrstack_zero.
    apply cm_eval_addrstack_zero.
  - !!assert (n <= lvl)%nat by lia.
    specialize h_impl_forall_x with (1:=h_chain_m_lvl_sp) (2:=heq_storev_x_m') (3:=h_le_n_lvl).
    cbn -[Mem.storev] in *.
    !inversion h_CM_eval_expr_v.
    specialize (h_impl_forall_x _ h_CM_eval_expr_vaddr).
    econstructor.
    + eassumption.
    + cbn in *.
      destruct vaddr; try discriminate.
      cbn in *.
      pose proof Mem.load_store_other _ _ _ _ _ _ heq_storev_x_m' AST.Mint32 b (Ptrofs.unsigned i) as h.
      rewrite <- h.
      * assumption.
      * !destruct h_eval_sp_lds.
        -- right.
           assert (i = Ptrofs.zero).
           { !!specialize chained_stack_structure_le with (1:=h_chain_m_lvl_sp) (2:=h_le_n_lvl) as ?.
             !!specialize chain_structure_spec with (1:=h_chain_m_n_sp) (g:=g)(e:=e) as ?.
             decomp h_ex.
             !!specialize det_eval_expr with (1:=h_CM_eval_expr) (2:=h_impl_forall_x) as ?.
             !inversion heq_vptr_b0_zero.
             reflexivity. }
           subst.
           left.
           cbn.
           rewrite Ptrofs.unsigned_zero.
           lia.
        -- left.
           eapply h_forall_n with (n:=n).
           ++ lia.
           ++ assert (i = Ptrofs.zero).
              { !!pose proof chain_aligned _ _ _ h_chain_m_lvl_sp lvl (le_n _) e g.
                red in h_aligned_g_m.
                !!assert (n <= lvl) by lia.
                specialize (h_aligned_g_m _ h_le_n_lvl0).
                decomp h_aligned_g_m.
                !! (subst_det_addrstack_zero;idtac).
                inversion heq_vptr_b_δ_zero.
                reflexivity. }
              subst.
              eassumption.
Qed.

Lemma storev_outside_struct_chain_preserves_var_addresses:
  forall sp0 e sp g m lvl,
      (* chainging addresses are unchanged. *)
      (forall n, (n < lvl)%nat -> forall b' ,
            Cminor.eval_expr g sp e m
                             ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) (Values.Vptr b' Ptrofs.zero)
            -> b' <> sp0) ->
      forall n, chained_stack_structure m lvl sp ->
           forall x _v _chk m' δ, Mem.storev _chk m (Values.Vptr sp0 _v) x = Some m' ->
                   (n <= lvl)%nat -> forall v,
                       Cminor.eval_expr g sp e m ((build_loads n δ)) v
                       -> Cminor.eval_expr g sp e m' ((build_loads n δ)) v.
Proof.
  !!intros until lvl.
  intros h_eval_sp_lds n.
  !intros.
  unfold build_loads in *.
  !invclear h_CM_eval_expr_v.
  econstructor;[ | |eassumption].
  - eapply storev_outside_struct_chain_preserves_chaining;eauto.
  - !inversion h_CM_eval_expr_v2.
    constructor.
    assumption.
Qed.

Lemma storev_outside_struct_chain_preserves_var_addresses2:
  forall sp0 e sp g m lvl,
      (* chainging addresses are unchanged. *)
      (forall n, (n < lvl)%nat -> forall b' ,
            Cminor.eval_expr g sp e m
                             ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) (Values.Vptr b' Ptrofs.zero)
            -> b' <> sp0) ->
      forall n, chained_stack_structure m lvl sp ->
           forall x _v _chk m' δ, Mem.storev _chk m (Values.Vptr sp0 _v) x = Some m' ->
                   (n <= lvl)%nat -> forall v,
                       Cminor.eval_expr g sp e m' ((build_loads n δ)) v
                       -> Cminor.eval_expr g sp e m ((build_loads n δ)) v.
Proof.
  !!intros until lvl.
  intros h_eval_sp_lds n.
  !intros.
  unfold build_loads in *.
  !invclear h_CM_eval_expr_v.
  econstructor;[ | |eassumption].
  - eapply storev_outside_struct_chain_preserves_chaining2;eauto.
  - !inversion h_CM_eval_expr_v2.
    constructor.
    assumption.
Qed.

(* The content of variable do not change either (we go one lvl less deep, since we add one ELoad.  *)
Lemma storev_outside_struct_chain_preserves_var_value:
  forall sp0 e sp g m lvl,
      (* chainging addresses are unchanged. *)
      (forall n, (n <= lvl)%nat -> forall b' ,
            Cminor.eval_expr g sp e m
                             ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) (Values.Vptr b' Ptrofs.zero)
            -> b' <> sp0) ->
      forall n, chained_stack_structure m lvl sp ->
           forall x _v _chk _chk' m' δ, Mem.storev _chk m (Values.Vptr sp0 _v) x = Some m' ->
                   (n <= lvl)%nat -> forall v,
                       Cminor.eval_expr g sp e m (Eload _chk' (build_loads n δ)) v
                       -> Cminor.eval_expr g sp e m' (Eload _chk' (build_loads n δ)) v.
Proof.
  !!intros.
  rename h_forall_n into h_unch.
  !inversion h_CM_eval_expr_v.
  assert (h_unch':forall n : nat,
             (n < lvl)%nat
             -> forall b' : Values.block,
               Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) (Values.Vptr b' Ptrofs.zero) -> b' <> sp0).
  { intros.
    eapply h_unch with (n:=n0).
    - lia.
    - assumption. }
  !!pose proof storev_outside_struct_chain_preserves_var_addresses _ _ _ _ _ _ h_unch' _ h_chain_m_lvl_sp _ _ _ _ _ heq_storev_x_m' h_le_n_lvl _ h_CM_eval_expr_vaddr.
  econstructor;eauto.
  unfold build_loads in h_CM_eval_expr_vaddr, h_CM_eval_expr_vaddr0.
  !invclear h_CM_eval_expr_vaddr.
  !invclear h_CM_eval_expr_vaddr0.
  destruct vaddr;try discriminate.
  pose proof Mem.load_store_other _ _ _ _ _ _ heq_storev_x_m' _chk' b (Ptrofs.unsigned i) as h.
  unfold Mem.loadv in *.
  rewrite h.
  - assumption.
  - left.
    !assert (v1=(Values.Vptr b Ptrofs.zero)).
    { clear h.
      !!pose proof chain_aligned _ _ _ h_chain_m_lvl_sp lvl (le_n _) e g.
      red in h_aligned_g_m.
      !!assert (n <= lvl) by lia.
      specialize (h_aligned_g_m _ h_le_n_lvl0).
      decomp h_aligned_g_m.
      subst_det_addrstack_zero.
      f_equal.
      cbn in *.
      destruct v2;try discriminate.
      inversion h_eval_binop_Oadd_v1_v2.
      destruct Archi.ptr64;auto. }
    subst.
    eapply h_unch;eauto.
Qed.

Proposition storev_outside_struct_chain_preserves_chained_structure:
  forall (sp0 : Values.block) (e : env) (sp : Values.val) (g : genv) (m : mem) (lvl : nat),
    (forall n : nat,
        (n < lvl)%nat
        -> forall b' : Values.block,
          Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) (Values.Vptr b' Ptrofs.zero) -> b' <> sp0)
    -> chained_stack_structure m lvl sp
    -> forall (x : Values.val) (_v : ptrofs) (_chk : AST.memory_chunk) (m' : mem),
        Mem.storev _chk m (Values.Vptr sp0 _v) x = Some m' ->
        chained_stack_structure m' lvl sp.
Proof.
  !intros.
  assert
    ( forall n, (n <= lvl)%nat -> forall v : Values.val,
          Cminor.eval_expr g sp e m (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) v
          -> Cminor.eval_expr g sp e m' (build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n) v).
  { !intro.
    eapply storev_outside_struct_chain_preserves_chaining;eauto. }
  destruct (chained_stack_struct_inv_sp_zero _ _ _ h_chain_m_lvl_sp).
  subst.
  eapply chained_stack_structure_spec.
  !intros.
  !!pose proof chain_structure_spec lvl0 m (Values.Vptr x0 Ptrofs.zero).
  !!edestruct h_impl_forall_g with (g:=g) (e:=e).
  eapply chained_stack_structure_le;eauto;try lia.
  eauto.
Qed.

Lemma malloc_distinct_from_chaining_loads_2 :
  forall lvl m sp,
    chained_stack_structure m lvl sp ->
    forall n sz m' new_sp,
      Mem.alloc m 0 sz = (m', new_sp) ->
      forall e g, (n < lvl)%nat -> forall b' ,
          Cminor.eval_expr g sp e m'
                           ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) (Values.Vptr b' Ptrofs.zero)
          -> b' <> new_sp.
Proof.
  !intros.
  assert (Cminor.eval_expr g sp e m
                           ((build_loads_ (Econst (Oaddrstack Ptrofs.zero)) n)) (Values.Vptr b' Ptrofs.zero)).
  { eapply malloc_preserves_chaining_loads_2;eauto.
    eapply chained_stack_structure_le;eauto;try lia. }
  eapply malloc_distinct_from_chaining_loads; eauto.
Qed.


From Perennial.goose_lang Require Import notation typing.
From Perennial.goose_lang Require Import proofmode lifting lib.into_val.
From Perennial.goose_lang.lib Require Export proph.impl.

Set Default Proof Using "Type".

Section goose_lang.
Context `{ffi_sem: ffi_semantics} `{!ffi_interp ffi} `{!heapGS Σ}.
Context {ext_ty: ext_types ext}.

(** list-based prophecy variables (the most general underlying primitive) *)

Theorem wp_NewProph_list :
  {{{ True }}}
    NewProph #()
  {{{ (p : proph_id) pvs, RET #p; proph p pvs }}}.
Proof.
  iIntros (Φ) "_ HΦ". wp_lam.
  wp_apply wp_new_proph. iIntros (pvs v). by iApply "HΦ".
Qed.

Theorem wp_ResolveProph_list E (p : proph_id) pvs v :
  {{{ proph p pvs }}}
    ResolveProph (#p) (Val v) @ E
  {{{ pvs', RET (LitV LitUnit); ⌜pvs = v::pvs'⌝ ∗ proph p pvs' }}}.
Proof.
  iIntros (Φ) "Hp HΦ". wp_lam.
  wp_apply (wp_resolve_proph with "Hp"). auto.
Qed.

(** typed assign-once prophecy variables *)
Section once.
  Context `{!IntoVal T}.

  Definition proph_once (p : proph_id) (x : T) : iProp Σ :=
    ∃ pvs : list val, proph p pvs ∗
               ⌜match v ← head pvs; from_val v with
                | Some x' => x=x'
                | None => True
                end⌝.

  Theorem wp_NewProph_once :
    {{{ True }}}
      NewProph #()
    {{{ (p : proph_id) (x : T), RET #p; proph_once p x }}}.
  Proof.
    iIntros (Φ) "_ HΦ". iApply wp_NewProph_list; first done.
    iIntros "!> %p %pvs Hp".
    iApply ("HΦ" $! p (default (IntoVal_def T) (v ← head pvs; from_val v))).
    iExists pvs. iFrame. iPureIntro.
    destruct (head pvs); simpl; last done.
    destruct (from_val v); done.
  Qed.

  Theorem wp_ResolveProph_once (p : proph_id) (x y : T) v :
    from_val v = Some y →
    {{{ proph_once p x }}}
      ResolveProph (#p) (Val v)
    {{{ RET (LitV LitUnit); ⌜x = y⌝ }}}.
  Proof.
    iIntros (Hv Φ) "(%pvs & Hp & %Hpvs) HΦ".
    iApply (wp_ResolveProph_list with "Hp").
    iIntros "!> %pvs' [%Hpvs' _]". iApply "HΦ". iPureIntro.
    subst pvs. simpl in Hpvs.
    rewrite Hv in Hpvs. done.
  Qed.

End once.

End goose_lang.