cap_machine.examples.macros

From iris.algebra Require Import frac.
From iris.proofmode Require Import proofmode.
Require Import Eqdep_dec List.
From cap_machine Require Import rules logrel.
From cap_machine.proofmode Require Import tactics_helpers map_simpl solve_pure.
From cap_machine Require Export iris_extra addr_reg_sample contiguous malloc assert.

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

  (* --------------------------------------------------------------------------------- *)
  (* ------------------------------------- FETCH ------------------------------------- *)
  (* --------------------------------------------------------------------------------- *)

  Definition fetch_instrs (f : Z) :=
    [move_r r_t1 PC;
    getb r_t2 r_t1;
    geta r_t3 r_t1;
    sub_r_r r_t2 r_t2 r_t3;
    lea_r r_t1 r_t2;
    load_r r_t1 r_t1;
    lea_z r_t1 f;
    move_z r_t2 0;
    move_z r_t3 0;
    load_r r_t1 r_t1].

  Definition fetch f a : iProp Σ :=
    ([∗ list] a_i;w_i a;(fetch_instrs f), a_i ↦ₐ w_i)%I.

  (* fetch spec *)
  Lemma fetch_spec f a pc_p pc_b pc_e a_first a_last b_link e_link a_link entry_a wentry φ w1 w2 w3:
    isCorrectPC_range pc_p pc_b pc_e a_first a_last ->
    contiguous_between a a_first a_last ->
    withinBounds b_link e_link entry_a = true ->
    (a_link + f)%a = Some entry_a ->

       fetch f a
     PC ↦ᵣ WCap pc_p pc_b pc_e a_first
     pc_b ↦ₐ WCap RO b_link e_link a_link
     entry_a ↦ₐ wentry
     r_t1 ↦ᵣ w1
     r_t2 ↦ᵣ w2
     r_t3 ↦ᵣ w3
    (* if the capability is global, we want to be able to continue *)
    (* if w is not a global capability, we will fail, and must now show that Phi holds at failV *)
     (PC ↦ᵣ WCap pc_p pc_b pc_e a_last fetch f a
            (* the newly allocated region *)
             r_t1 ↦ᵣ wentry r_t2 ↦ᵣ WInt 0%Z r_t3 ↦ᵣ WInt 0%Z
             pc_b ↦ₐ WCap RO b_link e_link a_link
             entry_a ↦ₐ wentry
            -∗ WP Seq (Instr Executable) {{ φ }})
    
      WP Seq (Instr Executable) {{ φ }}.
  Proof.
    iIntros (Hvpc Hcont Hwb Hentry) "(>Hprog & >HPC & >Hpc_b & >Ha_entry & >Hr_t1 & >Hr_t2 & >Hr_t3 & Hφ)".
    iDestruct (big_sepL2_length with "Hprog") as %Hlength.
    destruct a as [|a l];[inversion Hlength|].
    apply contiguous_between_cons_inv_first in Hcont as Heq. subst.
    (* move r_t1 PC *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg_fromPC with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 0|auto|..].
    iEpilogue "(HPC & Hprog_done & Hr_t1)".
    (* getb r_t2 r_t1 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_Get_success with "[$HPC $Hi $Hr_t1 $Hr_t2 ]");
      [apply decode_encode_instrW_inv|auto|iCorrectPC a_first a_last|iContiguous_next Hcont 1|auto..].
    iEpilogue "(HPC & Hi & Hr_t1 & Hr_t2) /="; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* geta r_t3 r_t1 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_Get_success with "[$HPC $Hi $Hr_t1 $Hr_t3]");
      [apply decode_encode_instrW_inv|auto|iCorrectPC a_first a_last|iContiguous_next Hcont 2|auto..].
    iEpilogue "(HPC & Hi & Hr_t1 & Hr_t3) /="; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* sub r_t2 r_t2 r_t3 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_add_sub_lt_success_dst_r with "[$HPC $Hi $Hr_t3 $Hr_t2]");
      [apply decode_encode_instrW_inv|auto|iContiguous_next Hcont 3|iCorrectPC a_first a_last|..].
    iEpilogue "(HPC & Hi & Hr_t3 & Hr_t2) /="; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* lea r_t1 r_t2 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    assert ((a_first + (pc_b - a_first))%a = Some pc_b) as Hlea;[solve_addr|].
    iApply (wp_lea_success_reg with "[$HPC $Hi $Hr_t1 $Hr_t2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 4|apply Hlea|auto..].
    { apply contiguous_between_length in Hcont.
      apply isCorrectPC_range_perm in Hvpc; [|revert Hcont; clear; solve_addr].
      destruct Hvpc as [-> | ->]; auto. }
    iEpilogue "(HPC & Hi & Hr_t2 & Hr_t1) /="; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* load r_t1 r_t1 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iAssert ((pc_b f4)%Z)%I as %Hneq.
    { iIntros (Hcontr);subst. iApply (addr_dupl_false with "Hi Hpc_b"). }
    iApply (wp_load_success_same with "[$HPC $Hi $Hr_t1 Hpc_b]");
      [|apply decode_encode_instrW_inv|iCorrectPC a_first a_last| | |iContiguous_next Hcont 5|..].
    { exact (WCap RW b_link e_link a_link). }
    { apply contiguous_between_length in Hcont as Hlen.
      assert (pc_b < pc_e)%Z as Hle.
      { eapply isCorrectPC_contiguous_range in Hvpc as Hwb';[|eauto|apply elem_of_cons;left;eauto].
        inversion Hwb'. solve_addr. }
      apply isCorrectPC_range_perm in Hvpc as Heq; [|revert Hlen; clear; solve_addr].
      destruct Heq as [-> | ->]; auto. }
    { apply andb_true_intro. split;[apply Z.leb_le;solve_addr|apply Z.ltb_lt;auto].
      assert (pc_b < pc_e)%Z as Hle.
      { eapply isCorrectPC_contiguous_range in Hvpc as Hwb';[|eauto|apply elem_of_cons;left;eauto].
        inversion Hwb'. solve_addr. } auto. }
    { destruct (pc_b =? f4)%a; [done|iFrame]. }
    destruct ((pc_b =? f4)%a) eqn:Hcontr;[apply Z.eqb_eq in Hcontr;apply finz_to_z_eq in Hcontr;congruence|clear Hcontr].
    iEpilogue "(HPC & Hr_t1 & Hi & Hpc_b)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* lea r_t1 f *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 6|apply Hentry|simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t2 0 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_move_success_z with "[$HPC $Hi $Hr_t2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 7|auto|..].
    iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t3 0 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_move_success_z with "[$HPC $Hi $Hr_t3]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 8|auto|..].
    iEpilogue "(HPC & Hi & Hr_t3)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* load r_t1 r_t1 *)
    destruct l;[|inversion Hlength].
    apply contiguous_between_last with (ai:=f8) in Hcont as Hlink;[|auto].
    iPrologue "Hprog".
    iAssert ((entry_a f8)%Z)%I as %Hneq'.
    { iIntros (Hcontr);subst. iApply (addr_dupl_false with "Hi Ha_entry"). }
    iApply (wp_load_success_same with "[$HPC $Hi $Hr_t1 Ha_entry]");
      [exact wentry|apply decode_encode_instrW_inv|iCorrectPC a_first a_last|auto|auto|apply Hlink|..].
    { destruct (entry_a =? f8)%a; auto. }
    destruct ((entry_a =? f8)%a) eqn:Hcontr;[apply Z.eqb_eq in Hcontr;apply finz_to_z_eq in Hcontr;congruence|clear Hcontr].
    iEpilogue "(HPC & Hr_t1 & Hi & Hentry_a)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* continuation *)
    iApply "Hφ".
    iFrame.
    do 9 iDestruct "Hprog_done" as "[$ Hprog_done]".
    iFrame.
  Unshelve. Fail idtac. Admitted.

  (* --------------------------------------------------------------------------------- *)
  (* ------------------------------------- ASSERT ------------------------------------ *)
  (* --------------------------------------------------------------------------------- *)

  Definition assert_instrs f_a :=
    fetch_instrs f_a ++
    [move_r r_t2 r_t0;
     move_r r_t0 PC;
     lea_z r_t0 3;
     jmp r_t1;
     move_r r_t0 r_t2;
     move_z r_t1 0;
     move_z r_t2 0].

  Definition assert a f_a :=
    ([∗ list] a_i;w_i a;(assert_instrs f_a), a_i ↦ₐ w_i)%I.

  (* Spec for assertion success *)
  (* Since we are not jumping to the failure subroutine, we do not need any assumptions
     about the failure subroutine *)

  Lemma assert_success a f_a pc_p pc_b pc_e a_first a_last
        b_link e_link a_link a_entry w0 w1 w2 w3 n1 n2
        ba a_flag ea assertN EN φ :
    isCorrectPC_range pc_p pc_b pc_e a_first a_last
    contiguous_between a a_first a_last
    (* linking table assumptions *)
    withinBounds b_link e_link a_entry = true
    (a_link + f_a)%a = Some a_entry
    assertN EN
    (* condition for assertion success *)
    (n1 = n2)

     assert a f_a
     na_inv logrel_nais assertN (assert_inv ba a_flag ea)
     na_own logrel_nais EN
     PC ↦ᵣ WCap pc_p pc_b pc_e a_first
     pc_b ↦ₐ WCap RO b_link e_link a_link
     a_entry ↦ₐ WCap E ba ea ba
     r_t0 ↦ᵣ w0
     r_t1 ↦ᵣ w1
     r_t2 ↦ᵣ w2
     r_t3 ↦ᵣ w3
     r_t4 ↦ᵣ WInt n1
     r_t5 ↦ᵣ WInt n2
     (r_t0 ↦ᵣ w0
         r_t1 ↦ᵣ WInt 0%Z r_t2 ↦ᵣ WInt 0%Z r_t3 ↦ᵣ WInt 0%Z
          r_t4 ↦ᵣ WInt 0%Z r_t5 ↦ᵣ WInt 0%Z
          PC ↦ᵣ WCap pc_p pc_b pc_e a_last assert a f_a
          na_own logrel_nais EN
          pc_b ↦ₐ WCap RO b_link e_link a_link a_entry ↦ₐ WCap E ba ea ba
         -∗ WP Seq (Instr Executable) {{ φ }})
    
    WP Seq (Instr Executable) {{ φ }}.
  Proof.
    iIntros (Hvpc Hcont Hwb Htable HN Hsuccess)
            "(>Hprog & #Hinv & Hna & >HPC & >Hpc_b & >Ha_entry & >Hr_t0 & >Hr_t1 & >Hr_t2 & >Hr_t3 & >Hr_t4 & >Hr_t5 & Hφ)".
     (* fetch f *)
    iDestruct (contiguous_between_program_split with "Hprog") as (fetch_prog rest link)
                                                                   "(Hfetch & Hprog & #Hcont)";[apply Hcont|].
    iDestruct "Hcont" as %(Hcont_fetch & Hcont_rest & Heqapp & Hlink).
    iApply (fetch_spec with "[- $HPC $Hfetch $Hr_t1 $Hr_t2 $Hr_t3 $Ha_entry $Hpc_b]");
      [|apply Hcont_fetch|apply Hwb|apply Htable|].
    { intros mid Hmid. apply isCorrectPC_inrange with a_first a_last; auto.
      apply contiguous_between_bounds in Hcont_rest. revert Hcont_rest Hmid; clear. solve_addr. }
    iNext. iIntros "(HPC & Hfetch& Hr_t1 & Hr_t2 & Hr_t3 & Hpc_b & Ha_entry)".
    iDestruct (big_sepL2_length with "Hprog") as %Hlength_rest.
    assert (isCorrectPC_range pc_p pc_b pc_e link a_last) as Hvpc_rest.
    { intros mid Hmid. apply isCorrectPC_inrange with a_first a_last; auto. revert Hmid Hlink;clear. solve_addr. }
    destruct rest as [|a0 l'];[inversion Hlength_rest|].
    apply contiguous_between_cons_inv_first in Hcont_rest as Heq. subst a0.
    (* move r_t2 r_t0 *)
    destruct l';[inversion Hlength_rest|]. subst n2.
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t2 $Hr_t0]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 0|].
    iEpilogue "(HPC & Hi & Hr_t2 & Hr_t0)"; iCombine "Hfetch" "Hi" as "Hprog_done".
    (* move r_t0 PC *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg_fromPC with "[$HPC $Hi $Hr_t0]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 1|].
    iEpilogue "(HPC & Hi & Hr_t0)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* lea r_t0 3 *)
    destruct l';[inversion Hlength_rest|].
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    assert (pc_p E).
    { assert (isCorrectPC (WCap pc_p pc_b pc_e a_first)) as HH.
      { apply Hvpc. split. solve_addr.
        apply contiguous_between_length in Hcont.
        rewrite Heqapp length_app /= in Hcont. solve_addr. }
      destruct pc_p; inversion HH; destruct_or?; auto. }
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t0]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|..].
    { iContiguous_next Hcont_rest 2. }
    { eapply (contiguous_between_incr_addr_middle' _ _ _ 1%nat 3).
      apply Hcont_rest. 2: done. 2: done. cbn. lia. } auto.
    iEpilogue "(HPC & Hi & Hr_t0)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* jmp r_t1 *)
    iPrologue "Hprog".
    iApply (wp_jmp_success with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* assert routine *)
    iApply (assert_success_spec with "[- $Hinv $Hna $HPC $Hr_t0 $Hr_t4 $Hr_t5]"); auto.
    iNext. iIntros "(Hna & HPC & Hr_t0 & Hr_t4 & Hr_t5)".
    rewrite updatePcPerm_cap_non_E//.
    (* move r_t0 r_t2 *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t0 $Hr_t2]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 4|].
    iEpilogue "(HPC & Hi & Hr_t0 & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t1 0 *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 5|].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t2 0 *)
    destruct l';[|inversion Hlength_rest].
    apply contiguous_between_last with (ai:=f4) in Hcont_rest as Hlink';[|auto].
    iPrologue "Hprog".
    iApply (wp_move_success_z with "[$HPC $Hi $Hr_t2]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|apply Hlink'|auto|..].
    iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* Continuation *)
    iApply "Hφ". iFrame.
    rewrite Heqapp /=. iDestruct "Hprog_done" as "(?&?&?&?&?&?&?&?)". iFrame. done.
  Unshelve. Fail idtac. Admitted.

  (* --------------------------------------------------------------------------------- *)
  (* ------------------------------------- MALLOC ------------------------------------ *)
  (* --------------------------------------------------------------------------------- *)

  (* malloc stores the result in r_t1, rather than a user chosen destination.
     f_m is the offset of the malloc capability *)

  Definition malloc_instrs f_m size :=
    fetch_instrs f_m ++
    [move_r r_t5 r_t0;
    move_r r_t3 r_t1;
    move_z r_t1 size;
    move_r r_t0 PC;
    lea_z r_t0 3;
    jmp r_t3;
    move_r r_t0 r_t5;
    move_z r_t5 0].

  Definition malloc f_m size a : iProp Σ :=
    ([∗ list] a_i;w_i a;(malloc_instrs f_m size), a_i ↦ₐ w_i)%I.

  (* malloc spec *)
  Lemma malloc_spec φ size cont a pc_p pc_b pc_e a_first a_last
        b_link e_link a_link f_m a_entry mallocN b_m e_m EN rmap :
    isCorrectPC_range pc_p pc_b pc_e a_first a_last
    contiguous_between a a_first a_last
    withinBounds b_link e_link a_entry = true
    (a_link + f_m)%a = Some a_entry
    dom rmap = all_registers_s {[ PC; r_t0 ]}
    mallocN EN
    size > 0

    (* malloc program and subroutine *)
     malloc f_m size a
     na_inv logrel_nais mallocN (malloc_inv b_m e_m)
     na_own logrel_nais EN
    (* we need to assume that the malloc capability is in the linking table at offset f_m *)
     pc_b ↦ₐ WCap RO b_link e_link a_link
     a_entry ↦ₐ WCap E b_m e_m b_m
    (* register state *)
     PC ↦ᵣ WCap pc_p pc_b pc_e a_first
     r_t0 ↦ᵣ cont
     ([∗ map] r_iw_i rmap, r_i ↦ᵣ w_i)
    (* continuation *)
     (PC ↦ᵣ WCap pc_p pc_b pc_e a_last malloc f_m size a
          pc_b ↦ₐ WCap RO b_link e_link a_link
          a_entry ↦ₐ WCap E b_m e_m b_m
         (* the newly allocated region *)
          ( (b e : Addr),
            (b + size)%a = Some e
             r_t1 ↦ᵣ WCap RWX b e b
             [[b,e]] ↦ₐ [[region_addrs_zeroes b e]])
          r_t0 ↦ᵣ cont
          na_own logrel_nais EN
          ([∗ map] r_iw_i (<[r_t2:=WInt 0%Z]>
                               (<[r_t3:=WInt 0%Z]>
                                (<[r_t4:=WInt 0%Z]>
                                 (<[r_t5:=WInt 0%Z]> (delete r_t1 rmap))))), r_i ↦ᵣ w_i)
         (* the newly allocated region is fresh in the current world *)
         (* ∗ ⌜Forall (λ a, a ∉ dom (gset Addr) (std W)) (finz.seq_between b e)⌝ *)
         -∗ WP Seq (Instr Executable) {{ φ }})
    
      WP Seq (Instr Executable) {{ λ v, φ v v = FailedV }}.
  Proof.
    iIntros (Hvpc Hcont Hwb Ha_entry Hrmap_dom HmallocN Hsize)
            "(>Hprog & #Hmalloc & Hna & >Hpc_b & >Ha_entry & >HPC & >Hr_t0 & >Hregs & Hφ)".
    (* extract necessary registers from regs *)
    iDestruct (big_sepL2_length with "Hprog") as %Hlength.
    assert (is_Some (rmap !! r_t1)) as [rv1 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t1 with "Hregs") as "[Hr_t1 Hregs]"; eauto.
    assert (is_Some (rmap !! r_t2)) as [rv2 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t2 with "Hregs") as "[Hr_t2 Hregs]". by rewrite lookup_delete_ne //.
    assert (is_Some (rmap !! r_t3)) as [rv3 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t3 with "Hregs") as "[Hr_t3 Hregs]". by rewrite !lookup_delete_ne //.
    assert (is_Some (rmap !! r_t5)) as [rv5 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t5 with "Hregs") as "[Hr_t5 Hregs]". by rewrite !lookup_delete_ne //.
    destruct a as [|a l];[inversion Hlength|].
    apply contiguous_between_cons_inv_first in Hcont as Heq. subst.
    (* fetch f *)
    iDestruct (contiguous_between_program_split with "Hprog") as (fetch_prog rest link)
                                                                   "(Hfetch & Hprog & #Hcont)";[apply Hcont|].
    iDestruct "Hcont" as %(Hcont_fetch & Hcont_rest & Heqapp & Hlink).
    iApply (fetch_spec with "[- $HPC $Hfetch $Hr_t1 $Hr_t2 $Hr_t3 $Ha_entry $Hpc_b]");
      [|apply Hcont_fetch|apply Hwb|apply Ha_entry|].
    { intros mid Hmid. apply isCorrectPC_inrange with a_first a_last; auto.
      apply contiguous_between_bounds in Hcont_rest. revert Hcont_rest Hmid; clear. solve_addr. }
    iNext. iIntros "(HPC & Hfetch& Hr_t1 & Hr_t2 & Hr_t3 & Hpc_b & Ha_entry)".
    iDestruct (big_sepL2_length with "Hprog") as %Hlength_rest.
    assert (isCorrectPC_range pc_p pc_b pc_e link a_last) as Hvpc_rest.
    { intros mid Hmid. apply isCorrectPC_inrange with a_first a_last; auto. revert Hmid Hlink;clear. solve_addr. }
    destruct rest as [|a l'];[inversion Hlength_rest|].
    apply contiguous_between_cons_inv_first in Hcont_rest as Heq. subst.
    (* move r_t5 r_t0 *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t5 $Hr_t0]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 0|auto|..].
    iEpilogue "(HPC & Hprog_done & Hr_t5 & Hr_t0)". iCombine "Hprog_done" "Hfetch" as "Hprog_done".
    (* move r_t3 r_t1 *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t3 $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 1|auto|..].
    iEpilogue "(HPC & Hi & Hr_t3 & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t1 size *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 2|auto|..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t0 PC *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg_fromPC with "[$HPC $Hi $Hr_t0]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 3|auto|..].
    iEpilogue "(HPC & Hi & Hr_t0)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* lea r_t0 3 *)
    destruct l';[inversion Hlength_rest|]. destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    assert ((f1 + 3)%a = Some f4) as Hlea.
    { apply (contiguous_between_incr_addr_middle _ _ _ 3 3 f1 f4) in Hcont_rest; auto. }
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t0]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 4|apply Hlea|auto..].
    { apply contiguous_between_length in Hcont.
      apply isCorrectPC_range_perm in Hvpc; [|revert Hcont; clear; solve_addr].
      destruct Hvpc as [-> | -> ]; auto. }
    iEpilogue "(HPC & Hi & Hr_t0)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* jmp r_t3 *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_jmp_success with "[$HPC $Hi $Hr_t3]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|].
    iEpilogue "(HPC & Hi & Hr_t3) /="; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* we are now ready to use the malloc subroutine spec. For this we prepare the registers *)
    iDestruct (big_sepM_insert _ _ r_t3 with "[$Hregs $Hr_t3]") as "Hregs".
      by rewrite lookup_delete_ne // lookup_delete.
    iDestruct (big_sepM_insert _ _ r_t2 with "[$Hregs $Hr_t2]") as "Hregs".
      by rewrite lookup_insert_ne // lookup_delete_ne // lookup_delete_ne // lookup_delete.
    map_simpl "Hregs".
    iDestruct (big_sepM_insert _ _ r_t5 with "[$Hregs $Hr_t5]") as "Hregs".
      by simplify_map_eq. map_simpl "Hregs".
    iApply (wp_wand with "[-]").
    iApply (simple_malloc_subroutine_spec with "[- $Hmalloc $Hna $Hregs $Hr_t0 $HPC $Hr_t1]"); auto.
    { rewrite !dom_insert_L dom_delete_L Hrmap_dom.
      rewrite !difference_difference_l_L !singleton_union_difference_L !all_registers_union_l.
      f_equal. }
    (* { lia. } *)
    iNext.
    rewrite updatePcPerm_cap_non_E.
    2: { eapply isCorrectPC_range_perm_non_E; eauto.
         generalize (contiguous_between_length _ _ _ Hcont_rest). cbn.
         clear; solve_addr. }
    iIntros "((Hna & Hregs) & Hr_t0 & HPC & Hbe) /=".
    iDestruct "Hbe" as (b e size' Hsize' Hbe) "(Hr_t1 & Hbe)". inversion Hsize'; subst size'.
    iDestruct (big_sepM_delete _ _ r_t3 with "Hregs") as "[Hr_t3 Hregs]".
      by rewrite lookup_insert_ne // lookup_insert //.
      rewrite delete_insert_ne // delete_insert_delete.
      repeat (rewrite delete_insert_ne //;[]). rewrite delete_insert_delete.
    iDestruct (big_sepM_delete _ _ r_t5 with "Hregs") as "[Hr_t5 Hregs]".
      by (repeat (rewrite lookup_insert_ne //;[]); rewrite lookup_insert //).
      repeat (rewrite delete_insert_ne //;[]). rewrite delete_insert_delete.
    (* move r_t0 r_t5 *)
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t0 $Hr_t5]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 6|auto|..].
    iEpilogue "(HPC & Hi & Hr_t0 & Hr_t5)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t5 0 *)
    destruct l';[| by inversion Hlength_rest].
    iPrologue "Hprog".
    apply contiguous_between_last with (ai:=f5) in Hcont_rest as Hlast;[|auto].
    iApply (wp_move_success_z with "[$HPC $Hi $Hr_t5]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|apply Hlast|auto|..].
    iEpilogue "(HPC & Hi & Hr_t5)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* continuation *)
    iApply "Hφ". 2: auto.
    iFrame "HPC". iSplitL "Hprog_done".
    { rewrite Heqapp. repeat (iDestruct "Hprog_done" as "[$ Hprog_done]"). iFrame. done. }
    iFrame.
    iDestruct (big_sepM_insert _ _ r_t5 with "[$Hregs $Hr_t5]") as "Hregs".
      repeat (rewrite lookup_insert_ne //;[]). apply lookup_delete.
    iDestruct (big_sepM_insert _ _ r_t3 with "[$Hregs $Hr_t3]") as "Hregs".
      simplify_map_eq. auto.
    repeat (rewrite (insert_commute _ r_t5) //;[]).
    map_simpl "Hregs". rewrite (insert_commute _ r_t2 r_t3); auto.
  Unshelve. Fail idtac. Admitted.

  (* malloc spec - alternative formulation *)
  Lemma malloc_spec_alt φ ψ size cont a pc_p pc_b pc_e a_first a_last
        b_link e_link a_link f_m a_entry mallocN b_m e_m EN rmap :
    isCorrectPC_range pc_p pc_b pc_e a_first a_last
    contiguous_between a a_first a_last
    withinBounds b_link e_link a_entry = true
    (a_link + f_m)%a = Some a_entry
    dom rmap = all_registers_s {[ PC; r_t0 ]}
    mallocN EN
    size > 0

    (* malloc program and subroutine *)
     malloc f_m size a
     na_inv logrel_nais mallocN (malloc_inv b_m e_m)
     na_own logrel_nais EN
    (* we need to assume that the malloc capability is in the linking table at offset f_m *)
     pc_b ↦ₐ WCap RO b_link e_link a_link
     a_entry ↦ₐ WCap E b_m e_m b_m
    (* register state *)
     PC ↦ᵣ WCap pc_p pc_b pc_e a_first
     r_t0 ↦ᵣ cont
     ([∗ map] r_iw_i rmap, r_i ↦ᵣ w_i)
    (* failure/continuation *)
     ( v, ψ v -∗ φ v)
     (ψ FailedV)
     (PC ↦ᵣ WCap pc_p pc_b pc_e a_last malloc f_m size a
          pc_b ↦ₐ WCap RO b_link e_link a_link
          a_entry ↦ₐ WCap E b_m e_m b_m
         (* the newly allocated region *)
          ( (b e : Addr),
            (b + size)%a = Some e
             r_t1 ↦ᵣ WCap RWX b e b
             [[b,e]] ↦ₐ [[region_addrs_zeroes b e]])
          r_t0 ↦ᵣ cont
          na_own logrel_nais EN
          ([∗ map] r_iw_i (<[r_t2:=WInt 0%Z]>
                               (<[r_t3:=WInt 0%Z]>
                                (<[r_t4:=WInt 0%Z]>
                                 (<[r_t5:=WInt 0%Z]> (delete r_t1 rmap))))), r_i ↦ᵣ w_i)
         (* the newly allocated region is fresh in the current world *)
         (* ∗ ⌜Forall (λ a, a ∉ dom (gset Addr) (std W)) (finz.seq_between b e)⌝ *)
         -∗ WP Seq (Instr Executable) {{ ψ }})
    
      WP Seq (Instr Executable) {{ λ v, φ v }}.
  Proof.
    iIntros (Hvpc Hcont Hwb Ha_entry Hrmap_dom HmallocN Hsize)
            "(>Hprog & #Hmalloc & Hna & >Hpc_b & >Ha_entry & >HPC & >Hr_t0 & >Hregs & Hψ & Hφfailed & Hφ)".
    (* extract necessary registers from regs *)
    iDestruct (big_sepL2_length with "Hprog") as %Hlength.
    assert (is_Some (rmap !! r_t1)) as [rv1 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t1 with "Hregs") as "[Hr_t1 Hregs]"; eauto.
    assert (is_Some (rmap !! r_t2)) as [rv2 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t2 with "Hregs") as "[Hr_t2 Hregs]". by rewrite lookup_delete_ne //.
    assert (is_Some (rmap !! r_t3)) as [rv3 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t3 with "Hregs") as "[Hr_t3 Hregs]". by rewrite !lookup_delete_ne //.
    assert (is_Some (rmap !! r_t5)) as [rv5 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t5 with "Hregs") as "[Hr_t5 Hregs]". by rewrite !lookup_delete_ne //.
    destruct a as [|a l];[inversion Hlength|].
    apply contiguous_between_cons_inv_first in Hcont as Heq. subst.
    (* fetch f *)
    iDestruct (contiguous_between_program_split with "Hprog") as (fetch_prog rest link)
                                                                   "(Hfetch & Hprog & #Hcont)";[apply Hcont|].
    iDestruct "Hcont" as %(Hcont_fetch & Hcont_rest & Heqapp & Hlink).
    iApply (fetch_spec with "[- $HPC $Hfetch $Hr_t1 $Hr_t2 $Hr_t3 $Ha_entry $Hpc_b]");
      [|apply Hcont_fetch|apply Hwb|apply Ha_entry|].
    { intros mid Hmid. apply isCorrectPC_inrange with a_first a_last; auto.
      apply contiguous_between_bounds in Hcont_rest. revert Hcont_rest Hmid; clear. solve_addr. }
    iNext. iIntros "(HPC & Hfetch& Hr_t1 & Hr_t2 & Hr_t3 & Hpc_b & Ha_entry)".
    iDestruct (big_sepL2_length with "Hprog") as %Hlength_rest.
    assert (isCorrectPC_range pc_p pc_b pc_e link a_last) as Hvpc_rest.
    { intros mid Hmid. apply isCorrectPC_inrange with a_first a_last; auto. revert Hmid Hlink;clear. solve_addr. }
    destruct rest as [|a l'];[inversion Hlength_rest|].
    apply contiguous_between_cons_inv_first in Hcont_rest as Heq. subst.
    (* move r_t5 r_t0 *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t5 $Hr_t0]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 0|auto|..].
    iEpilogue "(HPC & Hprog_done & Hr_t5 & Hr_t0)". iCombine "Hprog_done" "Hfetch" as "Hprog_done".
    (* move r_t3 r_t1 *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t3 $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 1|auto|..].
    iEpilogue "(HPC & Hi & Hr_t3 & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t1 size *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 2|auto|..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t0 PC *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg_fromPC with "[$HPC $Hi $Hr_t0]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 3|auto|..].
    iEpilogue "(HPC & Hi & Hr_t0)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* lea r_t0 3 *)
    destruct l';[inversion Hlength_rest|]. destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    assert ((f1 + 3)%a = Some f4) as Hlea.
    { apply (contiguous_between_incr_addr_middle _ _ _ 3 3 f1 f4) in Hcont_rest; auto. }
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t0]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 4|apply Hlea|auto..].
    { apply contiguous_between_length in Hcont.
      apply isCorrectPC_range_perm in Hvpc; [|revert Hcont; clear; solve_addr].
      destruct Hvpc as [-> | -> ]; auto. }
    iEpilogue "(HPC & Hi & Hr_t0)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* jmp r_t3 *)
    destruct l';[inversion Hlength_rest|].
    iPrologue "Hprog".
    iApply (wp_jmp_success with "[$HPC $Hi $Hr_t3]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|].
    iEpilogue "(HPC & Hi & Hr_t3) /="; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* we are now ready to use the malloc subroutine spec. For this we prepare the registers *)
    iDestruct (big_sepM_insert _ _ r_t3 with "[$Hregs $Hr_t3]") as "Hregs".
      by rewrite lookup_delete_ne // lookup_delete.
    iDestruct (big_sepM_insert _ _ r_t2 with "[$Hregs $Hr_t2]") as "Hregs".
      by rewrite lookup_insert_ne // lookup_delete_ne // lookup_delete_ne // lookup_delete.
    rewrite -(delete_insert_ne _ r_t5 r_t3) // insert_delete_insert.
    rewrite -(delete_insert_ne _ r_t5 r_t2) //.
    rewrite (insert_commute ((delete r_t2 _)) r_t2 r_t3) //.
    rewrite insert_delete_insert.
    iDestruct (big_sepM_insert _ _ r_t5 with "[$Hregs $Hr_t5]") as "Hregs".
      by rewrite lookup_delete. rewrite insert_delete_insert.
    iApply (wp_wand with "[- Hφfailed Hψ]").
    iApply (simple_malloc_subroutine_spec with "[- $Hmalloc $Hna $Hregs $Hr_t0 $HPC $Hr_t1]"); auto.
    { rewrite !dom_insert_L dom_delete_L Hrmap_dom.
      rewrite !difference_difference_l_L !singleton_union_difference_L !all_registers_union_l.
      f_equal. }
    (* { lia. } *)
    iNext.
    rewrite updatePcPerm_cap_non_E.
    2: { eapply isCorrectPC_range_perm_non_E; eauto.
         generalize (contiguous_between_length _ _ _ Hcont_rest). cbn.
         clear; solve_addr. }
    iIntros "((Hna & Hregs) & Hr_t0 & HPC & Hbe) /=".
    iDestruct "Hbe" as (b e size' Hsize' Hbe) "(Hr_t1 & Hbe)". inversion Hsize';subst size'.
    iDestruct (big_sepM_delete _ _ r_t3 with "Hregs") as "[Hr_t3 Hregs]".
      by rewrite lookup_insert_ne // lookup_insert //.
      rewrite delete_insert_ne // delete_insert_delete.
      repeat (rewrite delete_insert_ne //;[]). rewrite delete_insert_delete.
    iDestruct (big_sepM_delete _ _ r_t5 with "Hregs") as "[Hr_t5 Hregs]".
      by (repeat (rewrite lookup_insert_ne //;[]); rewrite lookup_insert //).
      repeat (rewrite delete_insert_ne //;[]). rewrite delete_insert_delete.
    (* move r_t0 r_t5 *)
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t0 $Hr_t5]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|iContiguous_next Hcont_rest 6|auto|..].
    iEpilogue "(HPC & Hi & Hr_t0 & Hr_t5)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move r_t5 0 *)
    destruct l';[| by inversion Hlength_rest].
    iPrologue "Hprog".
    apply contiguous_between_last with (ai:=f5) in Hcont_rest as Hlast;[|auto].
    iApply (wp_move_success_z with "[$HPC $Hi $Hr_t5]");
      [apply decode_encode_instrW_inv|iCorrectPC link a_last|apply Hlast|auto|..].
    iEpilogue "(HPC & Hi & Hr_t5)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* continuation *)
    iApply "Hφ". 2: iIntros (v) "[Hφ|Hφ] /="; iApply "Hψ"; iSimplifyEq; iFrame.
    iFrame "HPC". iSplitL "Hprog_done".
    { rewrite Heqapp. repeat (iDestruct "Hprog_done" as "[$ Hprog_done]"). iFrame. done. }
    iFrame.
    iDestruct (big_sepM_insert _ _ r_t5 with "[$Hregs $Hr_t5]") as "Hregs".
      repeat (rewrite lookup_insert_ne //;[]). apply lookup_delete.
    iDestruct (big_sepM_insert _ _ r_t3 with "[$Hregs $Hr_t3]") as "Hregs".
      repeat (rewrite lookup_insert_ne //;[]).
      rewrite lookup_delete_ne // lookup_delete //.
    repeat (rewrite (insert_commute _ r_t5) //;[]).
    rewrite insert_delete_insert -(delete_insert_ne _ _ r_t5) //.
    rewrite (insert_commute _ r_t5 r_t2) // (delete_insert_ne _ r_t3 r_t2)//.
    rewrite (insert_commute _ r_t4 r_t2) // insert_insert.
    rewrite (insert_commute _ r_t3 r_t2) //.
    rewrite -(delete_insert_ne _ r_t3) // insert_delete_insert.
    iFrame.
    auto.
  Unshelve. Fail idtac. Admitted.

  (* -------------------------------------- RCLEAR ----------------------------------- *)
  (* the following macro clears registers in r. a denotes the list of addresses
     containing the instructions for the clear: |a| = |r| *)

  Definition rclear_instrs (r : list RegName) := map (λ r_i, move_z r_i 0) r.

  Lemma rclear_instrs_cons rr r: rclear_instrs (rr :: r) = move_z rr 0 :: rclear_instrs r.
  Proof. reflexivity. Qed.

  Definition rclear (a : list Addr) (r : list RegName) : iProp Σ :=
      ([∗ list] ka_i;w_i a;(rclear_instrs r), a_i ↦ₐ w_i)%I.

  Lemma rclear_spec (a : list Addr) (r: list RegName) (rmap : gmap RegName Word) p b e a1 an φ :
    contiguous_between a a1 an
    ¬ PC r hd_error a = Some a1
    isCorrectPC_range p b e a1 an
    list_to_set r = dom rmap

       ([∗ map] r_iw_i rmap, r_i ↦ᵣ w_i)
     PC ↦ᵣ WCap p b e a1
     rclear a r
     (PC ↦ᵣ WCap p b e an ([∗ map] r_i_ rmap, r_i ↦ᵣ WInt 0%Z)
             rclear a r -∗
            WP Seq (Instr Executable) {{ φ }})
     WP Seq (Instr Executable) {{ φ }}.
  Proof.
    iIntros (Ha Hne Hhd Hvpc Hrdom) "(>Hreg & >HPC & >Hrclear & Hφ)".
    iDestruct (big_sepL2_length with "Hrclear") as %Har.
    iRevert (Hne Har Hhd Hvpc Ha Hrdom).
    iInduction (a) as [| a1'] "IH" forall (r rmap a1 an).
    { iIntros (Hne Har Hhd Hvpc Ha Hrdom). by inversion Hhd; simplify_eq. }
    iIntros (Hne Har Hhd Hvpc Ha Hrdom).
    iApply (wp_bind (fill [SeqCtx])). rewrite /rclear /=.
    (* rewrite -(beq_nat_refl (length r)).  *)destruct r; inversion Har.
    rewrite rclear_instrs_cons.
    iDestruct (big_sepL2_cons with "Hrclear") as "[Ha1 Hrclear]".
    rewrite list_to_set_cons in Hrdom.
    assert (is_Some (rmap !! r)) as [rv ?].
    { rewrite -elem_of_dom -Hrdom. set_solver. }
    iDestruct (big_sepM_delete _ _ r with "Hreg") as "[Hr Hreg]". eauto.
    pose proof (contiguous_between_cons_inv _ _ _ _ Ha) as [-> [a2 [? Hcont'] ] ].
    iApply (wp_move_success_z with "[$HPC $Hr $Ha1]");
      [apply decode_encode_instrW_inv|iCorrectPC a1 an|eauto|..].
    iNext. iIntros "(HPC & Ha1 & Hr)". iApply wp_pure_step_later; auto.
    iNext; iIntros "_".
    destruct a.
    { iApply "Hφ". iFrame. inversion Hcont'; subst. iFrame.
      destruct r0; inversion Har. simpl in Hrdom.
      iApply (big_sepM_delete _ _ r). eauto.
      rewrite (_: delete r rmap = ). rewrite !big_sepM_empty. eauto.
      apply map_empty. intro. eapply (@not_elem_of_dom _ _ (gset RegName)).
      typeclasses eauto. rewrite dom_delete_L -Hrdom. set_solver. }

    pose proof (contiguous_between_cons_inv_first _ _ _ _ Hcont') as ->.
    assert (PC r0). { apply not_elem_of_cons in Hne as [? ?]. auto. }

    destruct (decide (r r0)).
    { iDestruct (big_sepM_insert with "[$Hreg $Hr]") as "Hreg".
        by rewrite lookup_delete. rewrite insert_delete_insert.
      iApply ("IH" with "Hreg HPC Hrclear [Hφ Ha1]"); eauto.
      { iNext. iIntros "(? & Hreg & ?)". iApply "Hφ". iFrame.
        iApply (big_sepM_delete _ _ r). eauto.
        iDestruct (big_sepM_delete _ _ r with "Hreg") as "[? ?]".
        rewrite lookup_insert //. iFrame. rewrite delete_insert_delete //. }
      { iPureIntro. intros ? [? ?]. apply Hvpc. solve_addr. }
      { iPureIntro. rewrite dom_insert_L -Hrdom. set_solver. } }
    { iApply ("IH" with "Hreg HPC Hrclear [Hφ Ha1 Hr]"); eauto.
      { iNext. iIntros "(? & ? & ?)". iApply "Hφ". iFrame.
        iApply (big_sepM_delete _ _ r). eauto. iFrame. }
      { iPureIntro. intros ? [? ?]. apply Hvpc. solve_addr. }
      { iPureIntro. rewrite dom_delete_L -Hrdom. set_solver. } }
  Unshelve. Fail idtac. Admitted.

  (* -------------------------------------- MCLEAR ----------------------------------- *)
   (* the following macro clears the region of memory a capability govers over. a denotes
     the list of adresses containing the instructions for the clear. |a| = 23 *)


  Definition mclear_off_end := 10%Z.
  Definition mclear_off_iter := 2%Z.

  (* first we will define the list of Words making up the mclear macro *)
  Definition mclear_instrs r_stk :=
    [ move_r r_t4 r_stk;
      getb r_t1 r_t4;
      geta r_t2 r_t4;
      sub_r_r r_t2 r_t1 r_t2;
      lea_r r_t4 r_t2;
      gete r_t5 r_t4;
      sub_r_z r_t5 r_t5 1; (* we subtract the bound by one so that the lt check becomes a le check *)
      move_r r_t2 PC;
      lea_z r_t2 mclear_off_end; (* offset to "end" *)
      move_r r_t3 PC;
      lea_z r_t3 mclear_off_iter; (* offset to "iter" *)
    (* iter: *)
      lt_r_r r_t6 r_t5 r_t1;
      jnz r_t2 r_t6;
      store_z r_t4 0;
      lea_z r_t4 1;
      add_r_z r_t1 r_t1 1;
      jmp r_t3;
    (* end: *)
      move_z r_t4 0;
      move_z r_t1 0;
      move_z r_t2 0;
      move_z r_t3 0;
      move_z r_t5 0;
      move_z r_t6 0].

  (* Next we define mclear in memory, using a list of addresses of size 23 *)
  Definition mclear (a : list Addr) (r : RegName) : iProp Σ :=
    if ((length a) =? (length (mclear_instrs r)))%nat then
      ([∗ list] ka_i;w_i a;(mclear_instrs r), a_i ↦ₐ w_i)%I
    else
      False%I.

  Lemma mclear_iter_spec (a1 a2 a3 a4 a5 a6 b_r e_r a_r (* e_r' *) : Addr) ws (z : nat)
        p b e rt rt1 rt2 rt3 rt4 rt5 a_end (p_r : Perm) φ :
        isCorrectPC (WCap p b e a1)
       isCorrectPC (WCap p b e a2)
       isCorrectPC (WCap p b e a3)
       isCorrectPC (WCap p b e a4)
       isCorrectPC (WCap p b e a5)
       isCorrectPC (WCap p b e a6)
        (a1 + 1)%a = Some a2
       (a2 + 1)%a = Some a3
       (a3 + 1)%a = Some a4
       (a4 + 1)%a = Some a5
       (a5 + 1)%a = Some a6
        ((b_r + z < e_r)%Z withinBounds b_r e_r a_r = true)
        writeAllowed p_r = true
        (* (e_r + 1)*)
        (b_r + z)%a = Some a_r
      ([[a_r,e_r]] ↦ₐ [[ws]]
PC ↦ᵣ WCap p b e a1
      rt ↦ᵣ WCap p_r b_r e_r a_r
      rt1 ↦ᵣ WInt (b_r + z)%Z
      rt2 ↦ᵣ WInt ((z_of e_r) - 1)%Z
      ( w, rt3 ↦ᵣ w)
      rt4 ↦ᵣ WCap p b e a_end
      rt5 ↦ᵣ WCap p b e a1
      ([∗ list] a_i;w_i [a1;a2;a3;a4;a5;a6];[lt_r_r rt3 rt2 rt1;
                                                  jnz rt4 rt3;
                                                  store_z rt 0;
                                                  lea_z rt 1;
                                                  add_r_z rt1 rt1 1;
                                                  jmp rt5], a_i ↦ₐ w_i)
      (PC ↦ᵣ updatePcPerm (WCap p b e a_end)
              [[ a_r , e_r ]] ↦ₐ [[ region_addrs_zeroes a_r e_r ]]
( a_r, rt ↦ᵣ WCap p_r b_r e_r a_r)
              rt5 ↦ᵣ WCap p b e a1
              a3 ↦ₐ store_z rt 0
              a4 ↦ₐ lea_z rt 1
              a5 ↦ₐ add_r_z rt1 rt1 1
              a6 ↦ₐ jmp rt5
              a1 ↦ₐ lt_r_r rt3 rt2 rt1
              rt2 ↦ᵣ WInt ((z_of e_r) - 1)%Z
              ( z, rt1 ↦ᵣ WInt (b_r + z)%Z)
              a2 ↦ₐ jnz rt4 rt3
              rt4 ↦ᵣ WCap p b e a_end
              rt3 ↦ᵣ WInt 1%Z
              -∗ WP Seq (Instr Executable) {{ φ }})
      WP Seq (Instr Executable) {{ φ }})%I.
  Proof.
    iIntros (Hvpc Hnext Hwb Hwa (* Her' *) Hprogress)
            "(Hbe & >HPC & >Hrt & >Hr_t1 & >Hr_t2 & >Hr_t3 & >Hr_t4 & >Hr_t5 & >Hprog & Hφ)".
    iRevert (Hwb Hprogress).
    iLöb as "IH" forall (a_r ws z).
    iIntros (Hwb Hprogress).
    iDestruct "Hr_t3" as (w) "Hr_t3".
    destruct Hvpc as (Hvpc1 & Hvpc2 & Hvpc3 & Hvpc4 & Hvpc5 & Hvpc6).
    destruct Hnext as (Hnext1 & Hnext2 & Hnext3 & Hnext4 & Hnext5).
    iAssert (rt1 PC)%I as %Hne1.
    { destruct (reg_eq_dec rt1 PC); auto. rewrite e0.
        by iDestruct (regname_dupl_false with "Hr_t1 HPC") as "Hfalse". }
    iAssert (rt3 PC)%I as %Hne2.
    { destruct (reg_eq_dec rt3 PC); auto. rewrite e0.
        by iDestruct (regname_dupl_false with "Hr_t3 HPC") as "Hfalse". }
    iAssert (rt PC)%I as %Hne3.
    { destruct (reg_eq_dec rt PC); auto. rewrite e0.
        by iDestruct (regname_dupl_false with "Hrt HPC") as "Hfalse". }
    iAssert (rt2 rt3)%I as %Hne4.
    { destruct (reg_eq_dec rt2 rt3); auto. rewrite e0.
        by iDestruct (regname_dupl_false with "Hr_t2 Hr_t3") as "Hfalse". }
    iAssert (rt1 rt3)%I as %Hne5.
    { destruct (reg_eq_dec rt1 rt3); auto. rewrite e0.
        by iDestruct (regname_dupl_false with "Hr_t1 Hr_t3") as "Hfalse". }
    (* lt rt3 rt2 rt1 *)
    iDestruct "Hprog" as "[Hi Hprog]".
    iApply (wp_bind (fill [SeqCtx])).
    iApply (wp_add_sub_lt_success_r_r _ rt3 _ _ _ a1 _ _ _ rt2 _ rt1 _ _
      with "[Hi HPC Hr_t3 Hr_t1 Hr_t2]"); [apply decode_encode_instrW_inv | | | ..]; eauto.
    iFrame.
    iEpilogue "(HPC & Ha1 & Hr_t2 & Hr_t1 & Hr_t3)".
    rewrite /region_pointsto /finz.seq_between.
    destruct (Z.le_dec (b_r + z) (e_r - 1))%Z; simpl.
    - assert (Z.b2z (e_r - 1 <? b_r + z)%Z = 0%Z) as Heq0.
      { rewrite /Z.b2z. destruct (e_r - 1 <? b_r + z)%Z eqn:HH; auto.
        apply Z.ltb_lt in HH. lia. }
      rewrite Heq0.
      (* jnz rt4 rt3 *)
      iDestruct "Hprog" as "[Hi Hprog]".
      iApply (wp_bind (fill [SeqCtx])).
      iApply (wp_jnz_success_next _ rt4 rt3 _ _ _ a2 a3 with "[HPC Hi Hr_t3 Hr_t4]");
        first apply decode_encode_instrW_inv; eauto.
      iFrame. iEpilogue "(HPC & Ha2 & Hr_t4 & Hr_t3)".
      (* store rt 0 *)
      rewrite/ withinBounds in Hwb.
      apply andb_prop in Hwb as [Hwb_b%Z.leb_le Hwb_e%Z.ltb_lt].
      rewrite {1}finz_dist_S /=.
      destruct ws as [| w1 ws]; simpl; [by iApply bi.False_elim|].
      iDestruct "Hbe" as "[Ha_r Hbe]".
      iDestruct "Hprog" as "[Hi Hprog]".
      iApply (wp_bind (fill [SeqCtx])).
      iApply (wp_store_success_z _ _ _ _ a3 a4 _ rt 0 _ p_r b_r e_r a_r with "[HPC Hi Hrt Ha_r]"); first apply decode_encode_instrW_inv; eauto.
      { rewrite /withinBounds andb_true_iff; split;[auto|].
          by apply Z.leb_le. by apply Z.ltb_lt. }
      iFrame. iEpilogue "(HPC & Ha3 & Hrt & Ha_r)".
      (* lea rt 1 *)
      assert ( a_r', (a_r + 1)%a = Some a_r') as [a_r' Ha_r'].
      { apply addr_next_lt with e_r. apply incr_addr_of_z_i in Hprogress. lia. }
      iDestruct "Hprog" as "[Hi Hprog]".
      iApply (wp_bind (fill [SeqCtx])).
      iApply (wp_lea_success_z _ _ _ _ a4 a5 _ rt p_r _ _ a_r 1 a_r' with "[HPC Hi Hrt]"); first apply decode_encode_instrW_inv; eauto.
      { destruct p_r; auto. }
      iFrame. iEpilogue "(HPC & Ha4 & Hrt)".
      (* add rt1 rt1 1 *)
      iDestruct "Hprog" as "[Hi Hprog]".
      iApply (wp_bind (fill [SeqCtx])).
      iApply (wp_add_sub_lt_success_dst_z _ rt1 _ _ _ a5 _ _ _ with "[HPC Hi Hr_t1]"); try iFrame;
        [ apply decode_encode_instrW_inv | | |..]; eauto.
      iEpilogue "(HPC & Ha5 & Hr_t1)".
      (* jmp rt5 *)
      iDestruct "Hprog" as "[Hi _]".
      iApply (wp_bind (fill [SeqCtx])).
      iApply (wp_jmp_success _ _ _ _ a6 with "[HPC Hi Hr_t5]");
        first apply decode_encode_instrW_inv; eauto.
      iFrame. iEpilogue "(HPC & Ha6 & Hr_t5)".
      iApply ("IH" $! a_r' ws (z + 1)%nat with
                  "[Hbe] [HPC] [Hrt] [Hr_t1] [Hr_t2] [Hr_t3] [Hr_t4] [Hr_t5] [Ha1 Ha2 Ha3 Ha4 Ha5 Ha6] [Hφ Ha_r]")
      ; iFrame. all: auto.
      + by rewrite (addr_incr_eq Ha_r').
      + assert (updatePcPerm (WCap p b e a1) = (WCap p b e a1)).
        { rewrite /updatePcPerm. destruct p; auto.
          inversion Hvpc1; destruct H4 as [Hc | Hc ]; inversion Hc. }
        rewrite H. iFrame.
      + cbn. assert (b_r + z + 1 = b_r + (z + 1)%nat)%Z as ->;[lia|]. iFrame.
      + iNext.
        iIntros "(HPC & Hregion & Hrt & Hrt5 & Ha3 & Ha4 & Ha5 & Ha6 & Ha1 & Hrt2 & Hrt1 & Ha2 & Hrt4 & Hrt3)".
        iApply "Hφ".
        iFrame.
        rewrite /region_addrs_zeroes.
        rewrite (finz_dist_S a_r e_r) //= (_: (a_r^+1)%a = a_r'); [| solve_addr].
        iFrame.
      + iPureIntro. intro.
        rewrite andb_true_iff -Zle_is_le_bool -Zlt_is_lt_bool. solve_addr.
      + iPureIntro. solve_addr.
      + solve_addr.
    - assert (Z.b2z (e_r - 1 <? b_r + z)%Z = 1%Z) as Heq0.
      { rewrite /Z.b2z. destruct (e_r - 1 <? b_r + z)%Z eqn:HH; auto.
        apply Z.ltb_nlt in HH. lia. }
      rewrite Heq0.
      assert (e_r <= a_r)%Z by solve_addr.
      (* destruct (Z.le_dec a_r e_r). *)
      rewrite finz_dist_0 //=.
      destruct ws;[|by iApply bi.False_elim].
      (* jnz *)
      iDestruct "Hprog" as "[Hi Hprog]".
      iApply (wp_bind (fill [SeqCtx])).
      iApply (wp_jnz_success_jmp _ rt4 rt3 _ _ _ a2 _ _ (WInt 1%Z) with "[HPC Hi Hr_t3 Hr_t4]"); first apply decode_encode_instrW_inv; eauto.
      iFrame. iEpilogue "(HPC & Ha2 & Hr_t4 & Hr_t3)".
      iApply "Hφ". iDestruct "Hprog" as "(Ha3 & Ha4 & Ha5 & Ha6 & _)".
      rewrite /region_addrs_zeroes finz_dist_0 //=. iFrame.
  Unshelve. Fail idtac. Admitted.

  Lemma mclear_spec (a : list Addr) (r : RegName)
        (a_first a6' a_end : Addr) p b e p_r (b_r e_r a_r : Addr) a'
        w1 w2 w3 w4 w5 w6 ws φ :
    contiguous_between a a_first a'
    (* We will assume that we are not trying to clear memory in a *)
    r PC writeAllowed p_r = true
    (a !! 7 = Some a6' (a6' + 10)%a = Some a_end a !! 17 = Some a_end)

    isCorrectPC_range p b e a_first a'

    (* We will also assume the region to clear is non empty *)
    (b_r e_r)%Z

     (mclear a r
     PC ↦ᵣ WCap p b e a_first
     r ↦ᵣ WCap p_r b_r e_r a_r
     r_t4 ↦ᵣ w4
     r_t1 ↦ᵣ w1
     r_t2 ↦ᵣ w2
     r_t3 ↦ᵣ w3
     r_t5 ↦ᵣ w5
     r_t6 ↦ᵣ w6
     ([[ b_r , e_r ]] ↦ₐ [[ ws ]])
     (PC ↦ᵣ WCap p b e a'
             r_t1 ↦ᵣ WInt 0%Z
             r_t2 ↦ᵣ WInt 0%Z
             r_t3 ↦ᵣ WInt 0%Z
             r_t4 ↦ᵣ WInt 0%Z
             r_t5 ↦ᵣ WInt 0%Z
             r_t6 ↦ᵣ WInt 0%Z
             r ↦ᵣ WCap p_r b_r e_r a_r
             [[ b_r , e_r ]] ↦ₐ [[region_addrs_zeroes b_r e_r]]
mclear a r -∗
            WP Seq (Instr Executable) {{ φ }})
     WP Seq (Instr Executable) {{ φ }})%I.
  Proof.
    iIntros (Hnext [Hne Hwa] Hjnz_off Hvpc Hle)
            "(Hmclear & >HPC & >Hr & >Hr_t4 & >Hr_t1 & >Hr_t2 & >Hr_t3 & >Hr_t5 & >Hr_t6 & >Hregion & Hφ)".
    iAssert (((length a) =? (length (mclear_instrs r)) = true)%nat)%I as %Hlen.
    { destruct (((length a) =? (length (mclear_instrs r)))%nat) eqn:Hlen; auto.
      rewrite /mclear Hlen. by iApply bi.False_elim. }
    rewrite /mclear Hlen /mclear_instrs; simpl in Hlen. apply Nat.eqb_eq in Hlen.
    destruct a as [| a1 a]; inversion Hlen; simpl.
    move: (contiguous_between_cons_inv_first _ _ _ _ Hnext).
    match goal with |- (?a = _) -> _ => intro; subst a end.
    iPrologue "Hmclear".
    iApply (wp_move_success_reg _ _ _ _ a_first _ _ r_t4 _ r with "[HPC Hr Hr_t4 Hi]");
      first apply decode_encode_instrW_inv; first iCorrectPC a_first a'; eauto.
    { iContiguous_next Hnext 0. }
    iFrame. iEpilogue "(HPC & Ha_first & Hr_t4 & Hr)".
    (* getb r_t1 r_t4 *)
    iPrologue "Hprog".
    iApply (wp_Get_success _ _ r_t1 r_t4 _ _ _ a0 with "[$HPC $Hi $Hr_t1 $Hr_t4]");
      first eapply decode_encode_instrW_inv; first eauto; first iCorrectPC a_first a'; eauto.
    { iContiguous_next Hnext 1. }
    iFrame. iEpilogue "(HPC & Ha0 & Hr_t4 & Hr_t1)".
    destruct (reg_eq_dec PC r_t4) as [Hcontr | _]; [inversion Hcontr|].
    iCombine "Ha0 Ha_first" as "Hprog_done".
    (* geta r_t2 r_t4 *)
    iPrologue "Hprog".
    iApply (wp_Get_success _ _ r_t2 r_t4 _ _ _ a1 with "[HPC Hi Hr_t2 Hr_t4]");
      first eapply decode_encode_instrW_inv; first eapply is_Get_GetA ; first iCorrectPC a_first a'; auto.
    { iContiguous_next Hnext 2. }
    2: iFrame. auto. iEpilogue "(HPC & Ha1 & Hr_t4 & Hr_t2)".
    destruct (reg_eq_dec PC r_t4) as [Hcontr | _]; [inversion Hcontr|].
    iCombine "Ha1 Hprog_done" as "Hprog_done".
    (* sub r_t2 r_t1 r_t2 *)
    iPrologue "Hprog".
    (* destruct b_r eqn:Hb_r. *)
    iApply (wp_add_sub_lt_success_r_dst _ _ _ _ _ a2 _ _ r_t1 with "[HPC Hi Hr_t1 Hr_t2]"); try iFrame;
      [ apply decode_encode_instrW_inv | | |..]; eauto. 2: by iCorrectPC a_first a'.
    assert ((a2 + 1) = Some a3)%a as ->. { iContiguous_next Hnext 3. } by eauto.
    iEpilogue "(HPC & Ha2 & Hr_t1 & Hr_t2)".
    iCombine "Ha2 Hprog_done" as "Hprog_done".
    (* lea r_t4 r_t2 *)
    iPrologue "Hprog".
    assert (a_r + (b_r - a_r) = b_r)%Z as Haddmin; first lia.
    assert ((a_r + (b_r - a_r))%a = Some b_r) as Ha_rb_r by solve_addr.
    iApply (wp_lea_success_reg _ _ _ _ a3 a4 _ r_t4 r_t2 p_r _ _ a_r (b_r - a_r) with "[HPC Hi Hr_t4 Hr_t2]");
      first apply decode_encode_instrW_inv; first iCorrectPC a_first a'; eauto.
    { iContiguous_next Hnext 4. }
    { destruct p_r; inversion Hwa; auto. }
    by iFrame. iEpilogue "(HPC & Ha3 & Hr_t2 & Hr_t4)".
    iCombine "Ha3 Hprog_done" as "Hprog_done".
    (* gete r_t2 r_t4 *)
    iPrologue "Hprog".
    iApply (wp_Get_success _ _ r_t5 r_t4 _ _ _ a4 with "[HPC Hi Hr_t5 Hr_t4]"); try iFrame;
      first apply decode_encode_instrW_inv; first eauto; first iCorrectPC a_first a'; eauto.
    { iContiguous_next Hnext 5. }
    destruct (reg_eq_dec PC r_t4) as [Hcontr | _]; [inversion Hcontr|].
    destruct (reg_eq_dec r_t4 r_t5) as [Hcontr | _]; [inversion Hcontr|].
    iEpilogue "(HPC & Ha4 & Hr_t4 & Hr_t5)".
    iCombine "Ha4 Hprog_done" as "Hprog_done".
    (* sub r_t5 r_t5 1 *)
    iPrologue "Hprog".
    iApply (wp_add_sub_lt_success_dst_z with "[$HPC $Hi Hr_t5]");
      [apply decode_encode_instrW_inv| | |iCorrectPC a_first a'|..]; eauto.
    assert ((a5 + 1)%a = Some a6) as ->. { iContiguous_next Hnext 6. } eauto.
    iEpilogue "(HPC & Ha5 & Hr_t5)".
    iCombine "Ha5 Hprog_done" as "Hprog_done".
    (* move r_t2 PC *)
    iPrologue "Hprog".
    iApply (wp_move_success_reg_fromPC _ _ _ _ a6 a7 _ r_t2 with "[HPC Hi Hr_t2]");
      first apply decode_encode_instrW_inv; first iCorrectPC a_first a'; eauto.
    { iContiguous_next Hnext 7. }
    iFrame. iEpilogue "(HPC & Ha6 & Hr_t2)".
    iCombine "Ha6 Hprog_done" as "Hprog_done".
    (* lea r_t2 mclear_off_end *)
    iPrologue "Hprog".
    assert (p E) as Hpne.
    { have: (isCorrectPC (WCap p b e a_first)).
      { apply Hvpc. eapply contiguous_between_middle_bounds'; eauto. constructor. }
      inversion 1; subst.
      destruct H15 as [? | ? ]; subst; auto. }
    iApply (wp_lea_success_z _ _ _ _ a7 a8 _ r_t2 p _ _ a6 10 a_end with "[HPC Hi Hr_t2]");
      first apply decode_encode_instrW_inv; first iCorrectPC a_first a'; auto.
    { iContiguous_next Hnext 8. }
    { destruct Hjnz_off as (Ha7' & Hmclear_off_end & Ha_end). simpl in Ha7'. congruence. }
    iFrame. iEpilogue "(HPC & Ha7 & Hr_t2)".
    iCombine "Ha7 Hprog_done" as "Hprog_done".
    (* move r_t3 PC *)
    iPrologue "Hprog".
    iApply (wp_move_success_reg_fromPC _ _ _ _ a8 a9 _ r_t3 with "[HPC Hi Hr_t3]");
      first apply decode_encode_instrW_inv; first iCorrectPC a_first a'; auto.
    { iContiguous_next Hnext 9. }
    iFrame. iEpilogue "(HPC & Ha8 & Hr_t3)".
    iCombine "Ha8 Hprog_done" as "Hprog_done".
    (* lea r_t3 mclear_off_iter *)
    iPrologue "Hprog".
    iApply (wp_lea_success_z _ _ _ _ a9 a10 _ r_t3 p _ _ a8 2 a10 with "[HPC Hi Hr_t3]");
      first apply decode_encode_instrW_inv; first iCorrectPC a_first a'; auto.
    { iContiguous_next Hnext 10. }
    { assert (2 = 1 + 1)%Z as ->; auto.
      apply incr_addr_trans with a9. iContiguous_next Hnext 9.
      iContiguous_next Hnext 10. }
    iFrame. iEpilogue "(HPC & Ha9 & Hr_t3)".
    iCombine "Ha9 Hprog_done" as "Hprog_done".
    (* iter *)
    clear H0 H1 H2 H3 H4 H5 H6 H7 H8 H9.
    do 5 iPrologue_pre. clear H0 H1 H2 H3.
    iDestruct "Hprog" as "[Hi1 Hprog]".
    iDestruct "Hprog" as "[Hi2 Hprog]".
    iDestruct "Hprog" as "[Hi3 Hprog]".
    iDestruct "Hprog" as "[Hi4 Hprog]".
    iDestruct "Hprog" as "[Hi5 Hprog]".
    iDestruct "Hprog" as "[Hi6 Hprog]".
    iApply (mclear_iter_spec a10 a11 a12 a13 a14 a15 b_r e_r b_r _
                        0 p b e r_t4 r_t1 r_t5 r_t6 r_t2 r_t3 _ p_r
              with "[-]"); auto.
    - repeat apply conj; iCorrectPC a_first a'.
    - repeat split; solve [
        iContiguous_next Hnext 11; auto
      | iContiguous_next Hnext 12; auto
      | iContiguous_next Hnext 13; auto
      | iContiguous_next Hnext 14; auto
      | iContiguous_next Hnext 15; auto ].
    - (* rewrite Z.add_0_r. intros Hle. *)
      rewrite /withinBounds. intro.
      rewrite andb_true_iff Z.leb_le Z.ltb_lt. lia.
    - apply addr_add_0.
    - rewrite Z.add_0_r.
      iFrame.
      iSplitR; auto.
      iNext.
      iIntros "(HPC & Hbe & Hr_t4 & Hr_t3 & Ha11 & Ha12 & Ha13 & Ha14 & Ha9 & Hr_t5 & Hr_t1 & Ha10 & Hr_t2 & Hr_t6)".
      iCombine "Ha9 Ha10 Ha11 Ha12 Ha13 Ha14 Hprog_done" as "Hprog_done".
      iDestruct "Hr_t4" as (a_r0) "Hr_t4".
      iDestruct "Hr_t1" as (z0) "Hr_t1".
      iPrologue "Hprog".
      assert (a16 = a_end)%a as Ha16.
      { simpl in Hjnz_off.
        destruct Hjnz_off as (Ha16 & Ha16' & Hend).
        by inversion Hend.
      }
      destruct a as [| a17 a]; inversion Hlen.
      iApply (wp_move_success_z _ _ _ _ a16 a17 _ r_t4 _ 0 with "[HPC Hi Hr_t4]");
        first apply decode_encode_instrW_inv;
        first iCorrectPC a_first a'; auto.
      { iContiguous_next Hnext 17; auto. }
      { rewrite Ha16. destruct p; iFrame. contradiction. }
      iEpilogue "(HPC & Ha16 & Hr_t4)".
      (* move r_t1 0 *)
      iPrologue "Hprog".
      iApply (wp_move_success_z _ _ _ _ a17 a18 _ r_t1 _ 0 with "[HPC Hi Hr_t1]");
        first apply decode_encode_instrW_inv;
        first iCorrectPC a_first a'; auto.
      { iContiguous_next Hnext 18. }
      iFrame. iEpilogue "(HPC & Ha17 & Hr_t1)".
      (* move r_t2 0 *)
      iPrologue "Hprog".
      iApply (wp_move_success_z _ _ _ _ a18 a19 _ r_t2 _ 0 with "[HPC Hi Hr_t2]");
        first apply decode_encode_instrW_inv;
        first iCorrectPC a_first a'; auto.
      { iContiguous_next Hnext 19. }
      iFrame. iEpilogue "(HPC & Ha18 & Hr_t2)".
      (* move r_t3 0 *)
      iPrologue "Hprog".
      iApply (wp_move_success_z _ _ _ _ a19 a20 _ r_t3 _ 0 with "[HPC Hi Hr_t3]");
        first apply decode_encode_instrW_inv;
        first iCorrectPC a_first a'; auto.
      { iContiguous_next Hnext 20. }
      iFrame. iEpilogue "(HPC & Ha19 & Hr_t3)".
      (* move r_t5 0 *)
      iPrologue "Hprog".
      iApply (wp_move_success_z _ _ _ _ a20 a21 _ r_t5 _ 0 with "[HPC Hi Hr_t5]");
        first apply decode_encode_instrW_inv;
        first iCorrectPC a_first a'; auto.
      { iContiguous_next Hnext 21. }
      iFrame. iEpilogue "(HPC & Ha20 & Hr_t5)".
      (* move r_t6 0 *)
      iPrologue "Hprog".
      iApply (wp_move_success_z _ _ _ _ a21 a' _ r_t6 _ 0 with "[HPC Hi Hr_t6]");
        first apply decode_encode_instrW_inv;
        first iCorrectPC a_first a'; auto.
      { eapply contiguous_between_last. eapply Hnext. reflexivity. }
      iFrame. iEpilogue "(HPC & Ha21 & Hr_t6)".
      iApply "Hφ".
      iDestruct "Hprog_done" as "(Ha_iter & Ha10 & Ha12 & Ha11 & Ha13 & Ha14 & Ha15 & Ha8 & Ha7 & Ha6 & Ha5 & Ha4 & Ha3 & Ha2 & Ha1 & Ha0 & Ha_first)".
      iFrame.
  Unshelve. Fail idtac. Admitted.

  (* -------------------------------------- REQPERM ----------------------------------- *)
  (* the following macro requires that a given registers contains a capability with a
     given (encoded) permission. If this is not the case, the macro goes to fail,
     otherwise it continues *)


  Definition reqperm_instrs r z :=
    [
    get_wtype r_t1 r;
    sub_r_z r_t1 r_t1 (encodeWordType wt_cap);
    move_r r_t2 PC;
    lea_z r_t2 11;
    jnz r_t2 r_t1; (* if is_int(r) then jmp LABEL*)
    getp r_t1 r;
    sub_r_z r_t1 r_t1 z;
    move_r r_t2 PC;
    lea_z r_t2 6;
    jnz r_t2 r_t1;
    move_r r_t2 PC;
    lea_z r_t2 4;
    jmp r_t2;
    fail_end;
    move_z r_t1 0;
    move_z r_t2 0].

  Definition reqperm r z a : iProp Σ :=
    ([∗ list] a_i;w_i a;(reqperm_instrs r z), a_i ↦ₐ w_i)%I.

  Lemma reqperm_spec r perm a w pc_p pc_b pc_e a_first a_last φ :
    isCorrectPC_range pc_p pc_b pc_e a_first a_last ->
    contiguous_between a a_first a_last ->

       reqperm r (encodePerm perm) a
     PC ↦ᵣ WCap pc_p pc_b pc_e a_first
     r ↦ᵣ w
     ( w, r_t1 ↦ᵣ w)
     ( w, r_t2 ↦ᵣ w)
     (if isPermWord w perm then
            b e a', w = WCap perm b e a'
          (PC ↦ᵣ WCap pc_p pc_b pc_e a_last reqperm r (encodePerm perm) a
            r ↦ᵣ WCap perm b e a' r_t1 ↦ᵣ WInt 0%Z r_t2 ↦ᵣ WInt 0%Z
            -∗ WP Seq (Instr Executable) {{ φ }})
        else φ FailedV)
    
      WP Seq (Instr Executable) {{ φ }}.
  Proof.
    iIntros (Hvpc Hcont) "(>Hprog & >HPC & >Hr & >Hr_t1 & >Hr_t2 & Hcont)".
    iDestruct (big_sepL2_length with "Hprog") as %Hlength. simpl in *.
    iDestruct ("Hr_t1") as (w1) "Hr_t1".
    iAssert (r PC)%I as %Hne.
    { destruct (decide (r = PC)); auto; subst. iDestruct (regname_dupl_false with "HPC Hr") as %Hcontr. done. }

    iPrologue "Hprog".
    apply contiguous_between_cons_inv_first in Hcont as Heq. subst.
    destruct a as [|a l];[done|].
    iApply (wp_Get_success with "[$HPC $Hi $Hr $Hr_t1]")
    ; [apply decode_encode_instrW_inv|solve_pure|iCorrectPC a_first a_last |iContiguous_next Hcont 0|auto..].

    iEpilogue "(HPC & Hi & Hr & Hr_t1)". iRename "Hi" into "Hprog_done".

    iPrologue "Hprog".
    destruct l;[done|].
    iApply (wp_add_sub_lt_success_dst_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|auto|iContiguous_next Hcont 1|iCorrectPC a_first a_last|..].
    iEpilogue "(HPC & Hi & Hr_t1)". iCombine "Hi" "Hprog_done" as "Hprog_done".
    iSimpl in "Hr_t1".

    iPrologue "Hprog".
    destruct l;[done|].
    iDestruct "Hr_t2" as (w2) "Hr_t2".
    iApply (wp_move_success_reg_fromPC with "[$HPC $Hi $Hr_t2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 2|auto|..].
    iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".

    iPrologue "Hprog".
    do 12 (destruct l;[done|]).
    assert ((f + 11)%a = Some f10) as Hlea.
    { apply (contiguous_between_incr_addr_middle _ _ _ 2 11 f f10) in Hcont; auto. }
    assert (pc_p E) as HneE.
    { apply isCorrectPC_range_perm in Hvpc as [Heq | Heq ]; subst; auto.
      apply (contiguous_between_middle_bounds _ 0 a_first) in Hcont as [_ Hlt]; auto. }
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 3| exact |simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".

    destruct (is_cap w) eqn:Hcap ; cycle 1.
    {
      assert (isPermWord w perm = false) as ->. {destruct_word w; auto. inversion Hcap. }

      (* if w is not a capability we jump to the failure case *)
      iPrologue "Hprog".
      iApply (wp_jnz_success_jmp with "[$HPC $Hi $Hr_t2 $Hr_t1]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|..].
      { intros Hcontr; clear -Hcap Hcontr.
        destruct w; [| (destruct sb; [by simpl in Hcap|]) |]
        ; unfold wt_cap in Hcontr
        ; injection Hcontr
        ; clear Hcontr; intro Hcontr
        ; apply Zminus_eq in Hcontr
        ; match goal with
          | H: encodeWordType ?x = encodeWordType ?y |- _ =>
              pose proof (encodeWordType_correct x y) as Hcontr2 ; cbn in Hcontr2
          end
        ; auto.
      }
      iEpilogue "(HPC & Hi & Hr_t2 & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
      do 8 (iDestruct "Hprog" as "[Hi Hprog]"; iCombine "Hi" "Hprog_done" as "Hprog_done").
      (* fail *)
      iPrologue "Hprog".
      assert (updatePcPerm (WCap pc_p pc_b pc_e f10) = (WCap pc_p pc_b pc_e f10)) as ->.
      { destruct pc_p; auto. congruence. }
      iApply (wp_fail with "[$HPC $Hi]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|].
      iEpilogue "(HPC & Hi)". iApply wp_value. iApply "Hcont".
    }

    (* now we know that w is a capability *)
    assert ( p b e a, w = WCap p b e a) as (pc & bc & ec & ac & ->). {destruct_word w; inversion Hcap. eauto. }
    rewrite (_: (encodeWordType (WCap pc bc ec ac) - encodeWordType wt_cap)%Z = 0%Z); cycle 1.
    { rewrite (_ : (encodeWordType (WCap pc bc ec ac))%Z = (encodeWordType wt_cap)%Z)
      ; first lia. apply encodeWordType_correct_cap.
    }
    iPrologue "Hprog".
    iApply (wp_jnz_success_next with "[$HPC $Hi $Hr_t2 $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 4|..].
    iEpilogue "(HPC & Hi & Hr_t2 & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".

    iPrologue "Hprog".
    iApply (wp_Get_success with "[$HPC $Hi $Hr $Hr_t1]");
      [apply decode_encode_instrW_inv|auto|iCorrectPC a_first a_last|iContiguous_next Hcont 5|auto..].
    iEpilogue "(HPC & Hi & Hr & Hr_t1)". iCombine "Hi" "Hprog_done" as "Hprog_done".

    (* sub r_t1 r_t1 (encodeLoc Global) *)
    iPrologue "Hprog".
    iApply (wp_add_sub_lt_success_dst_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|auto|iContiguous_next Hcont 6|iCorrectPC a_first a_last|..].
    iEpilogue "(HPC & Hi & Hr_t1)". iCombine "Hi" "Hprog_done" as "Hprog_done".
    iSimpl in "Hr_t1".

    (* move r_t2 PC *)
    iPrologue "Hprog".
    iApply (wp_move_success_reg_fromPC with "[$HPC $Hi $Hr_t2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 7|auto|..].
    iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".

    (* lea r_t2 6 *)
    assert ((f4 + 6)%a = Some f10) as Hlea'.
    { apply (contiguous_between_incr_addr_middle _ _ _ 7 6 f4 f10) in Hcont; auto. }
    assert (pc_p E) as HneE'.
    { apply isCorrectPC_range_perm in Hvpc as [Heq | Heq ]; subst; auto.
      apply (contiguous_between_middle_bounds _ 0 a_first) in Hcont as [_ Hlt]; auto. }
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 8|apply Hlea'|auto..].
    iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    destruct (decide (encodePerm pc - encodePerm perm = 0))%Z as [e0|e0].
    - (* p is perm *)
      rewrite e0. assert (pc = perm);[apply encodePerm_inj;lia|subst].
      iSimpl in "Hcont". rewrite isPerm_refl. iDestruct "Hcont" as (b0 e1 a' Heq) "Hφ". inversion Heq; subst.
      iPrologue "Hprog".
      iApply (wp_jnz_success_next with "[$HPC $Hi $Hr_t2 $Hr_t1]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 9|..].
      iEpilogue "(HPC & Hi & Hr_t2 & Hr_t1)";iCombine "Hi" "Hprog_done" as "Hprog_done".
      (* move_r r_t2 PC *)
      iPrologue "Hprog".
      iApply (wp_move_success_reg_fromPC with "[$HPC $Hi $Hr_t2]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 10|auto|..].
      iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
      (* lea r_t2 3 *)
      assert ((f7 + 4)%a = Some f11) as Hlea''.
      { apply (contiguous_between_incr_addr_middle _ _ _ 10 4 f7 f11) in Hcont; auto. }
      iPrologue "Hprog".
      iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t2]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 11|apply Hlea''|auto..].
      iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
      (* jmp r_t2 *)
      iPrologue "Hprog".
      iApply (wp_jmp_success with "[$HPC $Hi $Hr_t2]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|..].
      iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
      assert (updatePcPerm (WCap pc_p pc_b pc_e f11) = (WCap pc_p pc_b pc_e f11)) as ->.
      { destruct pc_p; auto. congruence. }
      iDestruct "Hprog" as "[Hi Hprog]". iCombine "Hi" "Hprog_done" as "Hprog_done".
      (* move r_t1 0 *)
      iPrologue "Hprog".
      iApply (wp_move_success_z with "[$HPC $Hi $Hr_t1]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 14|auto|..].
      iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
      (* move r_t2 0 *)
      destruct l; [|done].
      iPrologue "Hprog".
      apply contiguous_between_last with (ai:=f12) in Hcont as Hnext;[|auto].
      iApply (wp_move_success_z with "[$HPC $Hi $Hr_t2]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|apply Hnext|auto|..].
      iEpilogue "(HPC & Hi & Hr_t2)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
      iApply "Hφ". iFrame "HPC Hr Hr_t1 Hr_t2".
      do 15 (iDestruct "Hprog_done" as "[Hi Hprog_done]"; iFrame "Hi").
      iFrame.
    - assert (pc perm) as HneP.
      { intros Hcontr. subst. lia. }
      iSimpl in "Hcont". rewrite isPerm_ne;[|auto].
      (* jnz r_t2 r_t1 *)
      iPrologue "Hprog".
      iApply (wp_jnz_success_jmp with "[$HPC $Hi $Hr_t2 $Hr_t1]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|..].
      { intros Hcontr. inversion Hcontr. done. }
      iEpilogue "(HPC & Hi & Hr_t2 & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
      do 3 (iDestruct "Hprog" as "[Hi Hprog]"; iCombine "Hi" "Hprog_done" as "Hprog_done").
      (* fail *)
      iPrologue "Hprog".
      assert (updatePcPerm (WCap pc_p pc_b pc_e f10) = (WCap pc_p pc_b pc_e f10)) as ->.
      { destruct pc_p; auto. congruence. }
      iApply (wp_fail with "[$HPC $Hi]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|].
      iEpilogue "(HPC & Hi)". iApply wp_value. iApply "Hcont".
  Unshelve. Fail idtac. Admitted.

  (* --------------------------------------- REQSIZE ----------------------------------- *)
  (* This macro checks that the capability in r covers a memory range of size
     (i.e. e-b) greater than minsize. *)


  Definition reqsize_instrs r (minsize: Z) :=
    [getb r_t1 r;
     gete r_t2 r;
     sub_r_r r_t1 r_t2 r_t1;
     lt_z_r r_t1 minsize r_t1;
     move_r r_t2 PC;
     lea_z r_t2 4;
     jnz r_t2 r_t1;
     fail_end].

  Definition reqsize r minsize a : iProp Σ :=
    ([∗ list] a_i;w_i a;(reqsize_instrs r minsize), a_i ↦ₐ w_i)%I.

  Lemma reqsize_spec r minsize a pc_p pc_b pc_e a_first a_last r_p r_b r_e r_a w1 w2 φ :
    isCorrectPC_range pc_p pc_b pc_e a_first a_last
    contiguous_between a a_first a_last

       reqsize r minsize a
     PC ↦ᵣ WCap pc_p pc_b pc_e a_first
     r ↦ᵣ WCap r_p r_b r_e r_a
     r_t1 ↦ᵣ w1
     r_t2 ↦ᵣ w2
     (if (minsize <? (r_e - r_b)%a)%Z then
           ( w1 w2,
            reqsize r minsize a
             PC ↦ᵣ WCap pc_p pc_b pc_e a_last
             r ↦ᵣ WCap r_p r_b r_e r_a
             r_t1 ↦ᵣ w1
             r_t2 ↦ᵣ w2)
           -∗ WP Seq (Instr Executable) {{ φ }}
        else φ FailedV)
    
    WP Seq (Instr Executable) {{ φ }}.
  Proof.
    iIntros (Hvpc Hcont) "(>Hprog & >HPC & >Hr & >Hr1 & >Hr2 & Hcont)".
    iDestruct (big_sepL2_length with "Hprog") as %Hlength. simpl in *.
    iAssert (r PC)%I as %Hne.
    { iIntros (->). iApply (regname_dupl_false with "HPC Hr"). }
    destruct a as [| a l];[done|].
    pose proof (contiguous_between_cons_inv_first _ _ _ _ Hcont) as ->.
    assert (pc_p E).
    { eapply isCorrectPC_range_perm_non_E; eauto.
      generalize (contiguous_between_length _ _ _ Hcont). rewrite Hlength /=.
      clear; solve_addr. }
    (* getb r_t1 r *)
    destruct l as [| ? l];[done|].
    iPrologue "Hprog".
    iApply (wp_Get_success with "[$HPC $Hi $Hr $Hr1]");
      [apply decode_encode_instrW_inv|auto|iCorrectPC a_first a_last|iContiguous_next Hcont 0|auto..];
      simpl.
    iEpilogue "(HPC & Hi & Hr & Hr1)". iRename "Hi" into "Hprog_done".
    (* gete r_t2 r *)
    destruct l as [| ? l];[done|].
    iPrologue "Hprog".
    iApply (wp_Get_success with "[$HPC $Hi $Hr $Hr2]");
      [apply decode_encode_instrW_inv|auto|iCorrectPC a_first a_last|iContiguous_next Hcont 1|auto..];
      simpl.
    iEpilogue "(HPC & Hi & Hr & Hr2)". iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* sub_r_r r_t1 r_t2 r_t1 *)
    destruct l as [| ? l];[done|].
    iPrologue "Hprog".
    iApply (wp_add_sub_lt_success_r_dst with "[$HPC $Hi $Hr2 $Hr1]");
      [apply decode_encode_instrW_inv|done|iContiguous_next Hcont 2|iCorrectPC a_first a_last|..];
      simpl.
    iEpilogue "(HPC & Hi & Hr2 & Hr1)". iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* lt_z_r r_t1 minsize r_t1 *)
    destruct l as [| ? l];[done|].
    iPrologue "Hprog".
    iApply (wp_add_sub_lt_success_z_dst with "[$HPC $Hi $Hr1]");
      [apply decode_encode_instrW_inv|done|iContiguous_next Hcont 3|iCorrectPC a_first a_last|..];
      simpl.
    iEpilogue "(HPC & Hi & Hr1)". iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* move_r r_t2 PC *)
    destruct l as [| ? l];[done|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg_fromPC with "[$HPC $Hi $Hr2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 4|auto..].
    iEpilogue "(HPC & Hi & Hr2)". iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* lea_z r_t2 4 *)
    destruct l as [| ? l];[done|].
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 5|try done..].
    { change 4%Z with (Z.of_nat (4%nat)).
      (* FIXME: a bit annoying to have to specify the index manually *)
      eapply (contiguous_between_middle_to_end _ _ _ 4); eauto. }
    iEpilogue "(HPC & Hi & Hr2)". iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* jnz r_t2 r_t1 *)
    destruct l as [| ? l];[done|].
    iPrologue "Hprog".
    destruct (minsize <? r_e - r_b)%Z eqn:Htest; simpl.
    { iApply (wp_jnz_success_jmp with "[$HPC $Hr2 $Hr1 $Hi]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|done|..].
      iEpilogue "(HPC & Hi & Hr2 & Hr1)". iApply "Hcont". iExists _,_.
      rewrite updatePcPerm_cap_non_E //. iFrame.
      iDestruct "Hprog_done" as "(?&?&?&?&?&?)". iFrame. }
    { iApply (wp_jnz_success_next with "[$HPC $Hr2 $Hr1 $Hi]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 6|..].
      iEpilogue "(HPC & Hi & Hr2 & Hr1)". iCombine "Hi" "Hprog_done" as "Hprog_done".
      (* fail_end *)
      iPrologue "Hprog".
      iApply (wp_fail with "[$HPC $Hi]");
        [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|..].
      iEpilogue "(HPC & Hi)". iApply wp_value. iApply "Hcont". }
  Unshelve. Fail idtac. Admitted.

  (* ---------------------------------------- CRTCLS ------------------------------------ *)
  (* The following macro creates a closure with one variable. A more general create closure would
     allow for more than one variable in the closure, but this is so far not necessary for our
     examples. The closure allocates a new region with a capability to the closure code, the closure
     variable, and the closure activation *)


  (* encodings of closure activation code *)
  Definition v1 := encodeInstr (Mov r_t1 (inr PC)).
  Definition v2 := encodeInstr (Lea r_t1 (inl 7%Z)).
  Definition v3 := encodeInstr (Load r_env r_t1).
  Definition v4 := encodeInstr (Lea r_t1 (inl (-1)%Z)).
  Definition v5 := encodeInstr (Load r_t1 r_t1).
  Definition v6 := encodeInstr (Jmp r_t1).

  Definition activation_instrs wcode wenv : list Word :=
    [ WInt v1; WInt v2; WInt v3; WInt v4; WInt v5; WInt v6; wcode; wenv ].

  (* scrtcls: "static" crtcls. Requires a capability for the memory region where to write
     the activation record.

     It assumes the pointer to the region for the activation record is in r_t1, the
     code pointer is in register rcode, and the data pointer in rdata.
  *)

  Definition scrtcls_instrs rcode rdata :=
    [store_z r_t1 v1;
     lea_z r_t1 1;
     store_z r_t1 v2;
     lea_z r_t1 1;
     store_z r_t1 v3;
     lea_z r_t1 1;
     store_z r_t1 v4;
     lea_z r_t1 1;
     store_z r_t1 v5;
     lea_z r_t1 1;
     store_z r_t1 v6;
     lea_z r_t1 1;
     store_r r_t1 rcode;
     move_z rcode 0;
     lea_z r_t1 1;
     store_r r_t1 rdata;
     move_z rdata 0;
     lea_z r_t1 (-7)%Z;
     restrict_z r_t1 e].

  Definition scrtcls rcode rdata a : iProp Σ :=
    ([∗ list] a_i;w_i a;(scrtcls_instrs rcode rdata), a_i ↦ₐ w_i)%I.

  (* crtcls: calls malloc to allocate memory for the activation record, then scrtcls. *)
  (* f_m denotes the offset to the malloc capability in the lookup table *)
  (* crtcls assumes that the code lies in register r_t1 and the variable lies in r_t2 *)
  Definition crtcls_instrs f_m :=
    [move_r r_t6 r_t1;
    move_r r_t7 r_t2] ++
    malloc_instrs f_m 8%nat ++
    scrtcls_instrs r_t6 r_t7.

  Definition crtcls f_m a : iProp Σ :=
    ([∗ list] a_i;w_i a;(crtcls_instrs f_m), a_i ↦ₐ w_i)%I.

  (* scrtcls *)
  Lemma scrtcls_spec rcode rdata wvar wcode a pc_p pc_b pc_e a_first a_last
        act_b act_e act φ :
    isCorrectPC_range pc_p pc_b pc_e a_first a_last
    contiguous_between a a_first a_last
    (act_b + 8)%a = Some act_e

       scrtcls rcode rdata a
     PC ↦ᵣ WCap pc_p pc_b pc_e a_first
    (* register state *)
     r_t1 ↦ᵣ WCap RWX act_b act_e act_b
     rcode ↦ᵣ wcode
     rdata ↦ᵣ wvar
    (* memory for the activation record *)
     ([[act_b,act_e]] ↦ₐ [[ act ]])
    (* continuation *)
     (PC ↦ᵣ WCap pc_p pc_b pc_e a_last scrtcls rcode rdata a
          r_t1 ↦ᵣ WCap E act_b act_e act_b
          [[act_b,act_e]] ↦ₐ [[ activation_instrs wcode wvar ]]
rcode ↦ᵣ WInt 0%Z
          rdata ↦ᵣ WInt 0%Z
         -∗ WP Seq (Instr Executable) {{ φ }})
    
      WP Seq (Instr Executable) {{ φ }}.
  Proof.
    iIntros (Hvpc Hcont Hact) "(>Hprog & >HPC & >Hr_t1 & >Hrcode & >Hrdata & >Hact & Hφ)".
    iDestruct (big_sepL2_length with "Hprog") as %Hlength.
    assert (act_b < act_e)%a as Hlt;[solve_addr|].
    opose proof (contiguous_between_region_addrs act_b act_e _) as Hcont_act; first solve_addr.
    unfold region_pointsto.
    remember (finz.seq_between act_b act_e) as acta.
    assert (Hact_len_a : length acta = 8).
    { rewrite Heqacta finz_seq_between_length. by apply finz_incr_iff_dist. }
    iDestruct (big_sepL2_length with "Hact") as %Hact_len.
    rewrite Hact_len_a in Hact_len. symmetry in Hact_len.
    repeat (destruct act as [| ? act]; try by inversion Hact_len). clear Hact_len.
    destruct a as [|a l]; [inversion Hlength|].
    apply contiguous_between_cons_inv_first in Hcont as Heq. subst a.
    assert ( i a', acta !! i = Some a' withinBounds act_b act_e a' = true) as Hwbact.
    { intros i a' Hsome. apply andb_true_intro. subst acta.
      apply contiguous_between_incr_addr with (i:=i) (ai:=a') in Hcont_act. 2: done.
      apply lookup_lt_Some in Hsome. split;[apply Z.leb_le|apply Z.ltb_lt]; solve_addr.
    }
    (* store_z r_t1 v1 *)
    destruct l; [inversion Hlength|].
    destruct acta as [| a0 acta]; [inversion Hact_len_a|].
    assert (a0 = act_b) as ->.
    { opose proof (finz_seq_between_first act_b act_e _) as HH; first solve_addr.
      rewrite -Heqacta /= in HH. by inversion HH. }
    iDestruct "Hact" as "[Ha0 Hact]".
    iPrologue "Hprog".
    iApply (wp_store_success_z with "[$HPC $Hi $Ha0 $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 0|..]; auto.
    { apply Hwbact with 0. auto. }
    iEpilogue "(HPC & Hi & Hr_t1 & Hact')"; iRename "Hi" into "Hprog_done".
    (* lea r_t1 1 *)
    destruct l;[inversion Hlength|].
    destruct acta as [| a1 acta]; [inversion Hact_len_a|].
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 1|
       iContiguous_next Hcont_act 0|simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* store_z r_t1 v2 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iDestruct "Hact" as "[Ha1 Hact]".
    iApply (wp_store_success_z with "[$HPC $Hi $Hr_t1 $Ha1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 2|..]; auto.
    { apply Hwbact with 1. auto. }
    iEpilogue "(HPC & Hi & Hr_t1 & Ha1)"; iCombine "Hi" "Hprog_done" as "Hprog_done"; iCombine "Ha1" "Hact'" as "Hact'".
    (* lea r_t1 1 *)
    destruct l;[inversion Hlength|].
    destruct acta as [| ? acta];[inversion Hact_len_a|].
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 3|
       iContiguous_next Hcont_act 1|simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* store_z r_t1 v3 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iDestruct "Hact" as "[Ha2 Hact]".
    iApply (wp_store_success_z with "[$HPC $Hi $Hr_t1 $Ha2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 4|..]; auto.
    { apply Hwbact with 2. auto. }
    iEpilogue "(HPC & Hi & Hr_t1 & Ha2)"; iCombine "Hi" "Hprog_done" as "Hprog_done"; iCombine "Ha2" "Hact'" as "Hact'".
    (* lea r_t1 1 *)
    destruct l;[inversion Hlength|].
    destruct acta as [| ? acta];[inversion Hact_len_a|].
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 5|
       iContiguous_next Hcont_act 2|simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* store_z r_t1 v4 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iDestruct "Hact" as "[Ha3 Hact]".
    iApply (wp_store_success_z with "[$HPC $Hi $Hr_t1 $Ha3]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 6|..]; auto.
    { apply Hwbact with 3. auto. }
    iEpilogue "(HPC & Hi & Hr_t1 & Ha3)"; iCombine "Hi" "Hprog_done" as "Hprog_done"; iCombine "Ha3" "Hact'" as "Hact'".
    (* lea r_t1 1 *)
    destruct l;[inversion Hlength|].
    destruct acta as [| ? acta];[inversion Hact_len_a|].
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 7|
       iContiguous_next Hcont_act 3|simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* store_z r_t1 v5 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iDestruct "Hact" as "[Ha4 Hact]".
    iApply (wp_store_success_z with "[$HPC $Hi $Hr_t1 $Ha4]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 8|..]; auto.
    { apply Hwbact with 4. auto. }
    iEpilogue "(HPC & Hi & Hr_t1 & Ha4)"; iCombine "Hi" "Hprog_done" as "Hprog_done"; iCombine "Ha4" "Hact'" as "Hact'".
    (* lea r_t1 1 *)
    destruct l;[inversion Hlength|].
    destruct acta as [| ? acta];[inversion Hact_len_a|].
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 9|
       iContiguous_next Hcont_act 4|simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* store_z r_t1 v6 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iDestruct "Hact" as "[Ha5 Hact]".
    iApply (wp_store_success_z with "[$HPC $Hi $Hr_t1 $Ha5]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 10|..]; auto.
    { apply Hwbact with 5. auto. }
    iEpilogue "(HPC & Hi & Hr_t1 & Ha5)"; iCombine "Hi" "Hprog_done" as "Hprog_done"; iCombine "Ha5" "Hact'" as "Hact'".
    (* lea r_t1 1 *)
    destruct l;[inversion Hlength|].
    destruct acta as [| ? acta];[inversion Hact_len_a|].
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 11|
       iContiguous_next Hcont_act 5|simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* store r_t1 rcode *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iDestruct "Hact" as "[Ha6 Hact]".
    iApply (wp_store_success_reg with "[$HPC $Hi $Ha6 $Hrcode $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 12|..]; auto.
    { apply Hwbact with 6. auto. }
    iEpilogue "(HPC & Hi & Hrcode & Hr_t1 & Ha6)"; iCombine "Hi" "Hprog_done" as "Hprog_done"; iCombine "Ha6" "Hact'" as "Hact'".
    (* move rcode 0 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_move_success_z with "[$HPC $Hi $Hrcode]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 13|auto..].
    iEpilogue "(HPC & Hi & Hrcode)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* lea r_t1 1 *)
    destruct l;[inversion Hlength|].
    destruct acta as [| ? acta];[inversion Hact_len_a|].
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 14|
       iContiguous_next Hcont_act 6|simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* store r_t1 rdata *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iDestruct "Hact" as "[Ha7 Hact]".
    iApply (wp_store_success_reg with "[$HPC $Hi $Ha7 $Hrdata $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 15|..]; auto.
    { apply Hwbact with 7. auto. }
    iEpilogue "(HPC & Hi & Hrdata & Hr_t1 & Ha7)"; iCombine "Hi" "Hprog_done" as "Hprog_done"; iCombine "Ha7" "Hact'" as "Hact'".
    (* move rdata 0 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_move_success_z with "[$HPC $Hi $Hrdata]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 16|auto..].
    iEpilogue "(HPC & Hi & Hrdata)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* lea r_t1 -7 *)
    destruct l;[by inversion Hlength|].
    destruct acta as [| ? acta];[| by inversion Hact_len_a].
    iPrologue "Hprog".
    apply contiguous_between_last with (ai:=f19) in Hcont_act as Hnext; auto.
    assert ((f19 + (-7))%a = Some act_b) as Hlea.
    { apply contiguous_between_length in Hcont_act. revert Hnext Hact; clear. solve_addr. }
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 17|apply Hlea|simpl;auto..].
    iEpilogue "(HPC & Hi & Hr_t1)";iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* restrict r_t1 (Global,E) *)
    destruct l;[|by inversion Hlength].
    apply contiguous_between_last with (ai:=f22) in Hcont as Hlast; auto.
    iPrologue "Hprog". iClear "Hprog".
    iApply (wp_restrict_success_z with "[$HPC $Hi $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|apply Hlast|auto..].
    { rewrite decode_encode_perm_inv. auto. }
    rewrite decode_encode_perm_inv.
    iEpilogue "(HPC & Hi & Hr_t1)"; iCombine "Hi" "Hprog_done" as "Hprog_done".
    (* continuation *)
    iApply "Hφ".
    iFrame "HPC". iSplitL "Hprog_done".
    { do 21 iDestruct "Hprog_done" as "[$ Hprog_done]". iFrame. done. }
    iFrame. do 7 iDestruct "Hact'" as "[$ Hact']". iFrame.
  Unshelve. Fail idtac. Admitted.

  (* crtcls spec *)
  Lemma crtcls_spec f_m wvar wcode a pc_p pc_b pc_e
        a_first a_last b_link a_link e_link a_entry b_m e_m mallocN EN rmap cont φ :
    isCorrectPC_range pc_p pc_b pc_e a_first a_last
    contiguous_between a a_first a_last
    withinBounds b_link e_link a_entry = true
    (a_link + f_m)%a = Some a_entry
    dom rmap = all_registers_s {[ PC; r_t0; r_t1; r_t2 ]}
    mallocN EN

       crtcls f_m a
     PC ↦ᵣ WCap pc_p pc_b pc_e a_first
     na_inv logrel_nais mallocN (malloc_inv b_m e_m)
     na_own logrel_nais EN
    (* we need to assume that the malloc capability is in the linking table at offset 0 *)
     pc_b ↦ₐ WCap RO b_link e_link a_link
     a_entry ↦ₐ WCap E b_m e_m b_m
    (* register state *)
     r_t0 ↦ᵣ cont
     r_t1 ↦ᵣ wcode
     r_t2 ↦ᵣ wvar
     ([∗ map] r_iw_i rmap, r_i ↦ᵣ w_i)
    (* continuation *)
     (PC ↦ᵣ WCap pc_p pc_b pc_e a_last crtcls f_m a
          pc_b ↦ₐ WCap RO b_link e_link a_link
          a_entry ↦ₐ WCap E b_m e_m b_m
         (* the newly allocated region *)
          ( (b e : Addr), (b + 8)%a = Some e r_t1 ↦ᵣ WCap E b e b
          [[b,e]] ↦ₐ [[ activation_instrs wcode wvar ]]
r_t0 ↦ᵣ cont
          r_t2 ↦ᵣ WInt 0%Z
          na_own logrel_nais EN
          ([∗ map] r_iw_i <[r_t3:=WInt 0%Z]>
                               (<[r_t4:=WInt 0%Z]>
                                (<[r_t5:=WInt 0%Z]>
                                 (<[r_t6:=WInt 0%Z]>
                                  (<[r_t7:=WInt 0%Z]> rmap)))), r_i ↦ᵣ w_i))
         -∗ WP Seq (Instr Executable) {{ φ }})
    
      WP Seq (Instr Executable) {{ λ v, φ v v = FailedV }}.
  Proof.
    iIntros (Hvpc Hcont Hwb Ha_entry Hrmap_dom HmallocN)
            "(>Hprog & >HPC & #Hmalloc & Hna & >Hpc_b & >Ha_entry & >Hr_t0 & >Hr_t1 & >Hr_t2 & >Hregs & Hφ)".
    (* get some registers out of regs *)
    iDestruct (big_sepL2_length with "Hprog") as %Hlength.
    assert (is_Some (rmap !! r_t6)) as [rv6 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t6 with "Hregs") as "[Hr_t6 Hregs]"; eauto.
    assert (is_Some (rmap !! r_t7)) as [rv7 ?]. by rewrite -elem_of_dom Hrmap_dom; set_solver.
    iDestruct (big_sepM_delete _ _ r_t7 with "Hregs") as "[Hr_t7 Hregs]". by rewrite lookup_delete_ne //.
    destruct a as [|a l];[inversion Hlength|].
    apply contiguous_between_cons_inv_first in Hcont as Heq. subst.
    (* move r_t6 r_t1 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t6 $Hr_t1]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 0|].
    iEpilogue "(HPC & Hprog_done & Hr_t6 & Hr_t1)".
    (* move r_t7 r_t2 *)
    destruct l;[inversion Hlength|].
    iPrologue "Hprog".
    iApply (wp_move_success_reg with "[$HPC $Hi $Hr_t7 $Hr_t2]");
      [apply decode_encode_instrW_inv|iCorrectPC a_first a_last|iContiguous_next Hcont 1|].
    iEpilogue "(HPC & Hi & Hr_t7 & Hr_t2)"; iCombine "Hi Hprog_done" as "Hprog_done".
    assert (contiguous_between (f0 :: l) f0 a_last) as Hcont'.
    { apply contiguous_between_cons_inv in Hcont as [_ (? & ? & Hcont)].
      apply contiguous_between_cons_inv in Hcont as [_ (? & ? & Hcont)].
      pose proof (contiguous_between_cons_inv_first _ _ _ _ Hcont). subst. apply Hcont. }
    (* malloc 8 *)
    iDestruct (contiguous_between_program_split with "Hprog") as
        (malloc_prog rest link) "(Hmalloc_prog & Hprog & #Hcont)";[apply Hcont'|].
    iDestruct "Hcont" as %(Hcont_fetch & Hcont_rest & Heqapp & Hlink).
    (* we start by putting the registers back together *)
    iDestruct (big_sepM_insert with "[$Hregs $Hr_t6]") as "Hregs".
      by rewrite lookup_delete_ne // lookup_delete.
      rewrite delete_commute // insert_delete_insert.
    iDestruct (big_sepM_insert with "[$Hregs $Hr_t7]") as "Hregs".
      by rewrite lookup_insert_ne // lookup_delete.
      rewrite (insert_commute _ r_t7 r_t6) // insert_delete_insert.
    assert ( (r:RegName), r ({[PC;r_t0;r_t1;r_t2]} : gset RegName) rmap !! r = None) as Hnotin_rmap.
    { intros r Hr. eapply (@not_elem_of_dom _ _ (gset RegName)). typeclasses eauto.
      rewrite Hrmap_dom. set_solver. }
    iDestruct (big_sepM_insert with "[$Hregs $Hr_t2]") as "Hregs".
      by rewrite !lookup_insert_ne //; apply Hnotin_rmap; set_solver.
    iDestruct (big_sepM_insert with "[$Hregs $Hr_t1]") as "Hregs".
      by rewrite !lookup_insert_ne //; apply Hnotin_rmap; set_solver.
    (* apply the malloc spec *)
    rewrite -/(malloc _ _ _).
    iApply (malloc_spec with "[- $HPC $Hmalloc $Hna $Hpc_b $Ha_entry $Hr_t0 $Hregs $Hmalloc_prog]");
      [|apply Hcont_fetch|apply Hwb|apply Ha_entry| |auto|lia|..].
    { intros mid Hmid. apply isCorrectPC_inrange with a_first a_last; auto.
      apply contiguous_between_bounds in Hcont_rest.
      apply contiguous_between_incr_addr with (i:=2) (ai:=f0) in Hcont;auto.
      revert Hcont Hcont_rest Hmid; clear. solve_addr. }
    { rewrite !dom_insert_L. rewrite Hrmap_dom.
      repeat (rewrite singleton_union_difference_L all_registers_union_l).
      f_equal. }
    iNext. iIntros "(HPC & Hmalloc_prog & Hpc_b & Ha_entry & Hbe & Hr_t0 & Hna & Hregs)".
    iDestruct "Hbe" as (b e Hbe) "(Hr_t1 & Hbe)".
    rewrite delete_insert_delete.
    rewrite (delete_insert_ne _ r_t1 r_t2) //.
    repeat (rewrite (insert_commute _ _ r_t2) //;[]).
    rewrite insert_insert.
    iDestruct (big_sepM_delete _ _ r_t6 with "Hregs") as "[Hr_t6 Hregs]".
      by rewrite !lookup_insert_ne // lookup_delete_ne // lookup_insert //.
    iDestruct (big_sepM_delete _ _ r_t7 with "Hregs") as "[Hr_t7 Hregs]".
      rewrite lookup_delete_ne // !lookup_insert_ne // lookup_delete_ne //
              lookup_insert_ne // lookup_insert //.
    iApply (scrtcls_spec with "[- $Hprog $HPC $Hr_t1 $Hr_t6 $Hr_t7 $Hbe]"); eauto.
    { intros mid Hmid. apply isCorrectPC_inrange with a_first a_last; auto.
      apply contiguous_between_bounds in Hcont_rest.
      apply contiguous_between_bounds in Hcont_fetch.
      apply contiguous_between_incr_addr with (i:=2) (ai:=f0) in Hcont; auto.
      revert Hmid Hcont_rest Hcont_fetch Hcont ; clear. solve_addr. }
    iNext. iIntros "(HPC & Hscrtcls_prog & Hr_t1 & Hact & Hr_t6 & Hr_t7)".
    (* continuation *)
    iApply "Hφ". iFrame "HPC Hpc_b Ha_entry". iSplitL "Hprog_done Hmalloc_prog Hscrtcls_prog".
    { rewrite Heqapp. iDestruct "Hprog_done" as "[? ?]". iFrame. }
    iExists b,e. iSplitR;auto. iFrame.
    iDestruct (big_sepM_delete _ _ r_t2 with "Hregs") as "[Hr_t2 Hregs]".
      by do 2 (rewrite lookup_delete_ne //); rewrite lookup_insert //.
    iFrame "Hr_t2".
    iDestruct (big_sepM_insert with "[$Hregs $Hr_t6]") as "Hregs".
      by do 2 (rewrite lookup_delete_ne //); rewrite lookup_delete //.
    iDestruct (big_sepM_insert with "[$Hregs $Hr_t7]") as "Hregs".
      by rewrite lookup_insert_ne // lookup_delete_ne // lookup_delete //.
    repeat (repeat (rewrite delete_insert_ne //; []); rewrite delete_insert_delete).
    rewrite (delete_notin _ r_t1). 2: apply Hnotin_rmap; set_solver.
    rewrite (delete_notin _ r_t2). 2: rewrite !lookup_delete_ne //; apply Hnotin_rmap; set_solver.
    repeat (rewrite -delete_insert_ne //; []). rewrite insert_delete_insert.
    repeat (rewrite -delete_insert_ne //; []). rewrite insert_delete_insert.
    repeat (rewrite (insert_commute _ r_t7) //;[]).
    repeat (rewrite (insert_commute _ r_t6) //;[]). rewrite (insert_commute _ r_t6 r_t5) //.
  Unshelve. Fail idtac. Admitted.

  (* ------------------------------- Closure Activation --------------------------------- *)

  Lemma closure_activation_spec pc_p b_cls e_cls r1v renvv wcode wenv φ :
    readAllowed pc_p = true
    isCorrectPC_range pc_p b_cls e_cls b_cls e_cls
    pc_p E
    PC ↦ᵣ WCap pc_p b_cls e_cls b_cls
     r_t1 ↦ᵣ r1v
     r_env ↦ᵣ renvv
     [[b_cls, e_cls]]↦ₐ[[ activation_instrs wcode wenv ]]
( PC ↦ᵣ updatePcPerm wcode
        r_t1 ↦ᵣ wcode
        r_env ↦ᵣ wenv
        [[b_cls, e_cls]]↦ₐ[[ activation_instrs wcode wenv ]]
-∗ WP Seq (Instr Executable) {{ φ }})
    
      WP Seq (Instr Executable) {{ φ }}.
  Proof.
    iIntros (Hrpc Hvpc HnpcE) "(HPC & Hr1 & Hrenv & Hcls & Hcont)".
    rewrite /region_pointsto.
    iDestruct (big_sepL2_length with "Hcls") as %Hcls_len. simpl in Hcls_len.
    assert (b_cls + 8 = Some e_cls)%a as Hbe.
    { rewrite finz_seq_between_length /finz.dist in Hcls_len.
      revert Hcls_len; clear; solve_addr. }
    assert (contiguous_between (finz.seq_between b_cls e_cls) b_cls e_cls) as Hcont_cls.
    { apply contiguous_between_of_region_addrs; auto. revert Hbe; clear; solve_addr. }
    pose proof (finz_seq_between_NoDup b_cls e_cls) as Hcls_nodup.
    iDestruct (big_sepL2_split_at 6 with "Hcls") as "[Hcls_code Hcls_data]".
    cbn [take drop].
    destruct (finz.seq_between b_cls e_cls) as [| ? ll]; [by inversion Hcls_len|].
    pose proof (contiguous_between_cons_inv_first _ _ _ _ Hcont_cls). subst.
    do 7 (destruct ll as [| ? ll]; [by inversion Hcls_len|]).
    destruct ll;[| by inversion Hcls_len]. cbn [take drop].
    iDestruct "Hcls_data" as "(Hcls_ptr & Hcls_env & _)".
    (* move r_t1 PC *)
    iPrologue "Hcls_code".
    iApply (wp_move_success_reg_fromPC with "[$HPC $Hi $Hr1]");
      [apply decode_encode_instrW_inv| iCorrectPC b_cls e_cls |
       iContiguous_next Hcont_cls 0 |..].
    iEpilogue "(HPC & Hprog_done & Hr1)".
    (* lea r_t1 7 *)
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr1]");
      [apply decode_encode_instrW_inv | iCorrectPC b_cls e_cls |
       iContiguous_next Hcont_cls 1 | | done | ..].
    { eapply contiguous_between_incr_addr_middle' with (i:=0); eauto.
      cbn. clear. lia. }
    iEpilogue "(HPC & Hi & Hr1)". iCombine "Hi Hprog_done" as "Hprog_done".
    (* load r_env r_t1 *)
    iPrologue "Hprog".
    (* FIXME: tedious & fragile *)
    assert ((f5 =? f0)%a = false) as H_5_0.
    { apply Z.eqb_neq. intros Heqb. assert (f5 = f0) as ->. revert Heqb; clear; solve_addr.
      exfalso. by pose proof (NoDup_lookup _ 2 7 _ Hcls_nodup eq_refl eq_refl). }
    iApply (wp_load_success with "[$HPC $Hi $Hrenv $Hr1 Hcls_env]");
      [apply decode_encode_instrW_inv | iCorrectPC b_cls e_cls |
       split;[done|] | iContiguous_next Hcont_cls 2 | ..].
    { eapply contiguous_between_middle_bounds' in Hcont_cls as [? ?].
      by eapply le_addr_withinBounds; eauto. repeat constructor. }
    { rewrite H_5_0. iFrame. }
    iEpilogue "(HPC & Hrenv & Hi & Hr1 & Hcls_env)". rewrite H_5_0.
    iCombine "Hi Hprog_done" as "Hprog_done".
    (* lea r_t1 (-1) *)
    iPrologue "Hprog".
    iApply (wp_lea_success_z with "[$HPC $Hi $Hr1]");
      [apply decode_encode_instrW_inv | iCorrectPC b_cls e_cls |
       iContiguous_next Hcont_cls 3 | | done | ..].
    { assert ((f4 + 1)%a = Some f5) as HH. by iContiguous_next Hcont_cls 6.
      instantiate (1 := f4). revert HH. clear; solve_addr. }
    iEpilogue "(HPC & Hi & Hr1)". iCombine "Hi Hprog_done" as "Hprog_done".
    (* load r_t1 r_t1 *)
    iPrologue "Hprog".
    (* FIXME: tedious & fragile *)
    assert ((f4 =? f2)%a = false) as H_4_2.
    { apply Z.eqb_neq. intros Heqb. assert (f4 = f2) as ->. revert Heqb; clear; solve_addr.
      exfalso. by pose proof (NoDup_lookup _ 4 6 _ Hcls_nodup eq_refl eq_refl). }
    iApply (wp_load_success_same with "[$HPC $Hi $Hr1 Hcls_ptr]");
      [(* FIXME *) auto | apply decode_encode_instrW_inv | iCorrectPC b_cls e_cls |
       done | auto | iContiguous_next Hcont_cls 4 | ..].
    { eapply contiguous_between_middle_bounds' in Hcont_cls as [? ?].
      by eapply le_addr_withinBounds; eauto. repeat constructor. }
    { rewrite H_4_2. iFrame. }
    iEpilogue "(HPC & Hr1 & Hi & Hcls_ptr)". rewrite H_4_2.
    iCombine "Hi Hprog_done" as "Hprog_done".
    (* jmp r_t1 *)
    iPrologue "Hprog".
    iApply (wp_jmp_success with "[$HPC $Hi $Hr1]");
      [apply decode_encode_instrW_inv | iCorrectPC b_cls e_cls | .. ].
    iEpilogue "(HPC & Hi & Hr1)".

    iApply "Hcont". do 4 (iDestruct "Hprog_done" as "(? & Hprog_done)"). iFrame.
  Unshelve. Fail idtac. Admitted.

End macros.