Commit 5a7b2bf6 authored by Lennard Gäher's avatar Lennard Gäher Committed by Michael Sammler
Browse files

dynamic alloc/free

parent 13f33068
Pipeline #55127 passed with stage
in 31 minutes and 45 seconds
......@@ -22,8 +22,8 @@ Definition heapUR : ucmra :=
Class heapG Σ := HeapG {
heap_heap_inG :> inG Σ (authR heapUR);
heap_heap_name : gname;
heap_alloc_range_map_inG :> ghost_mapG Σ alloc_id (Z * nat);
heap_alloc_range_map_name : gname;
heap_alloc_meta_map_inG :> ghost_mapG Σ alloc_id (Z * nat * alloc_kind);
heap_alloc_meta_map_name : gname;
heap_alloc_alive_map_inG :> ghost_mapG Σ alloc_id bool;
heap_alloc_alive_map_name : gname;
heap_fntbl_inG :> ghost_mapG Σ addr function;
......@@ -39,11 +39,11 @@ Definition to_heap_cellR (hc : heap_cell) : heap_cellR :=
Definition to_heapUR : heap heapUR :=
fmap to_heap_cellR.
Definition to_alloc_rangeR (al : allocation) : (Z * nat) :=
(al.(al_start), al.(al_len)).
Definition to_alloc_metaR (al : allocation) : (Z * nat * alloc_kind) :=
(al.(al_start), al.(al_len), al.(al_kind)).
Definition to_alloc_range_map : allocs gmap alloc_id (Z * nat) :=
fmap to_alloc_rangeR.
Definition to_alloc_meta_map : allocs gmap alloc_id (Z * nat * alloc_kind) :=
fmap to_alloc_metaR.
Definition to_alloc_alive_map : allocs gmap alloc_id bool :=
fmap al_alive.
......@@ -53,20 +53,20 @@ Section definitions.
(** * Allocation stuff. *)
(** [alloc_range id al] persistently records the information that allocation
(** [alloc_meta id al] persistently records the information that allocation
with identifier [id] has a range corresponding to that of [a]. *)
Definition alloc_range_def (id : alloc_id) (al : allocation) : iProp Σ :=
id [ heap_alloc_range_map_name ] to_alloc_rangeR al.
Definition alloc_range_aux : seal (@alloc_range_def). by eexists. Qed.
Definition alloc_range := unseal alloc_range_aux.
Definition alloc_range_eq : @alloc_range = @alloc_range_def :=
seal_eq alloc_range_aux.
Definition alloc_meta_def (id : alloc_id) (al : allocation) : iProp Σ :=
id [ heap_alloc_meta_map_name ] to_alloc_metaR al.
Definition alloc_meta_aux : seal (@alloc_meta_def). by eexists. Qed.
Definition alloc_meta := unseal alloc_meta_aux.
Definition alloc_meta_eq : @alloc_meta = @alloc_meta_def :=
seal_eq alloc_meta_aux.
Global Instance allocs_range_pers id al : Persistent (alloc_range id al).
Proof. rewrite alloc_range_eq. by apply _. Qed.
Global Instance allocs_range_pers id al : Persistent (alloc_meta id al).
Proof. rewrite alloc_meta_eq. by apply _. Qed.
Global Instance allocs_range_tl id al : Timeless (alloc_range id al).
Proof. rewrite alloc_range_eq. by apply _. Qed.
Global Instance allocs_range_tl id al : Timeless (alloc_meta id al).
Proof. rewrite alloc_meta_eq. by apply _. Qed.
(** [loc_in_bounds l n] persistently records the information that location
[l] and any of its positive offset up to [n] (included) are in range of the
......@@ -75,7 +75,7 @@ Section definitions.
Definition loc_in_bounds_def (l : loc) (n : nat) : iProp Σ :=
(id : alloc_id) (al : allocation),
l.1 = ProvAlloc (Some id) al.(al_start) l.2 l.2 + n al_end al
allocation_in_range al alloc_range id al.
allocation_in_range al alloc_meta id al.
Definition loc_in_bounds_aux : seal (@loc_in_bounds_def). by eexists. Qed.
Definition loc_in_bounds := unseal loc_in_bounds_aux.
Definition loc_in_bounds_eq : @loc_in_bounds = @loc_in_bounds_def :=
......@@ -156,8 +156,8 @@ Section definitions.
(** * Freeable *)
Definition freeable_def (l : loc) (n : nat) : iProp Σ :=
id, l.1 = ProvAlloc (Some id) alloc_range id {| al_start := l.2; al_len := n; al_alive := true |}
Definition freeable_def (l : loc) (n : nat) (k : alloc_kind) : iProp Σ :=
id, l.1 = ProvAlloc (Some id) alloc_meta id {| al_start := l.2; al_len := n; al_alive := true; al_kind := k |}
alloc_alive id (DfracOwn 1) true.
Definition freeable_aux : seal (@freeable_def). by eexists. Qed.
Definition freeable := unseal freeable_aux.
......@@ -169,8 +169,8 @@ Section definitions.
Definition heap_ctx (h : heap) : iProp Σ :=
own heap_heap_name ( to_heapUR h).
Definition alloc_range_ctx (ub : allocs) : iProp Σ :=
ghost_map_auth heap_alloc_range_map_name 1 (to_alloc_range_map ub).
Definition alloc_meta_ctx (ub : allocs) : iProp Σ :=
ghost_map_auth heap_alloc_meta_map_name 1 (to_alloc_meta_map ub).
Definition alloc_alive_ctx (ub : allocs) : iProp Σ :=
ghost_map_auth heap_alloc_alive_map_name 1 (to_alloc_alive_map ub).
......@@ -181,7 +181,7 @@ Section definitions.
Definition heap_state_ctx (st : heap_state) : iProp Σ :=
heap_state_invariant st
heap_ctx st.(hs_heap)
alloc_range_ctx st.(hs_allocs)
alloc_meta_ctx st.(hs_allocs)
alloc_alive_ctx st.(hs_allocs).
Definition state_ctx (σ:state) : iProp Σ :=
......@@ -241,68 +241,70 @@ Section fntbl.
Qed.
End fntbl.
Section alloc_range.
Section alloc_meta.
Context `{!heapG Σ}.
Implicit Types am : allocs.
Lemma alloc_range_mono id a1 a2 :
Lemma alloc_meta_mono id a1 a2 :
alloc_same_range a1 a2
alloc_range id a1 - alloc_range id a2.
Proof. destruct a1 as [???], a2 as [???] => -[/= <- <-]. by rewrite alloc_range_eq. Qed.
a1.(al_kind) = a2.(al_kind)
alloc_meta id a1 - alloc_meta id a2.
Proof. destruct a1 as [????], a2 as [????] => -[/= <- <-] <-. by rewrite alloc_meta_eq. Qed.
Lemma alloc_range_agree id a1 a2 :
alloc_range id a1 - alloc_range id a2 - alloc_same_range a1 a2.
Lemma alloc_meta_agree id a1 a2 :
alloc_meta id a1 - alloc_meta id a2 - alloc_same_range a1 a2.
Proof.
destruct a1 as [???], a2 as [???]. rewrite alloc_range_eq /alloc_same_range.
destruct a1 as [????], a2 as [????]. rewrite alloc_meta_eq /alloc_same_range.
iIntros "H1 H2". by iDestruct (ghost_map_elem_agree with "H1 H2") as %[=->->].
Qed.
Lemma alloc_range_alloc am id al :
Lemma alloc_meta_alloc am id al :
am !! id = None
alloc_range_ctx am ==
alloc_range_ctx (<[id := al]> am) alloc_range id al.
alloc_meta_ctx am ==
alloc_meta_ctx (<[id := al]> am) alloc_meta id al.
Proof.
move => Hid. rewrite alloc_range_eq. iIntros "Hctx".
move => Hid. rewrite alloc_meta_eq. iIntros "Hctx".
iMod (ghost_map_insert_persist with "Hctx") as "[? $]". { by rewrite lookup_fmap fmap_None. }
by rewrite -fmap_insert.
Qed.
Lemma alloc_range_to_loc_in_bounds l id (n : nat) al:
Lemma alloc_meta_to_loc_in_bounds l id (n : nat) al:
l.1 = ProvAlloc (Some id)
al.(al_start) l.2 l.2 + n al_end al
allocation_in_range al
alloc_range id al - loc_in_bounds l n.
alloc_meta id al - loc_in_bounds l n.
Proof.
iIntros (?[??]?) "Hr". rewrite loc_in_bounds_eq.
iExists id, al. by iFrame "Hr".
Qed.
Lemma alloc_range_lookup am id al :
alloc_range_ctx am -
alloc_range id al -
al', am !! id = Some al' alloc_same_range al al'.
Lemma alloc_meta_lookup am id al :
alloc_meta_ctx am -
alloc_meta id al -
al', am !! id = Some al' alloc_same_range al al' al.(al_kind) = al'.(al_kind).
Proof.
rewrite alloc_range_eq. iIntros "Htbl Hf".
rewrite alloc_meta_eq. iIntros "Htbl Hf".
iDestruct (ghost_map_lookup with "Htbl Hf") as %Hlookup.
iPureIntro. move: Hlookup. rewrite lookup_fmap fmap_Some => -[[???][?[??]]].
iPureIntro. move: Hlookup. rewrite lookup_fmap fmap_Some => -[[????][?[???]]].
by eexists _.
Qed.
Lemma alloc_range_ctx_same_range am id al1 al2 :
Lemma alloc_meta_ctx_same_range am id al1 al2 :
am !! id = Some al1
alloc_same_range al1 al2
alloc_range_ctx am = alloc_range_ctx (<[id := al2]> am).
al1.(al_kind) = al2.(al_kind)
alloc_meta_ctx am = alloc_meta_ctx (<[id := al2]> am).
Proof.
move => Hid [Heq1 Heq2].
rewrite /alloc_range_ctx /to_alloc_range_map fmap_insert insert_id; first done.
move => Hid [Heq1 Heq2] Heq3.
rewrite /alloc_meta_ctx /to_alloc_meta_map fmap_insert insert_id; first done.
rewrite lookup_fmap Hid /=. destruct al1, al2; naive_solver.
Qed.
Lemma alloc_range_ctx_killed am id al :
Lemma alloc_meta_ctx_killed am id al :
am !! id = Some al
alloc_range_ctx am = alloc_range_ctx (<[id := killed al]> am).
Proof. move => ?. by apply: alloc_range_ctx_same_range. Qed.
End alloc_range.
alloc_meta_ctx am = alloc_meta_ctx (<[id := killed al]> am).
Proof. move => ?. by apply: alloc_meta_ctx_same_range. Qed.
End alloc_meta.
Section alloc_alive.
Context `{!heapG Σ}.
......@@ -349,7 +351,7 @@ Section loc_in_bounds.
iDestruct "H2" as (?? Hl2 ? Hend ?) "#H2".
move: Hl1 Hl2 => /= Hl1 Hl2. iExists id, al.
destruct l. unfold al_end in *. simpl in *. simplify_eq.
iDestruct (alloc_range_agree with "H2 H1") as %[? <-].
iDestruct (alloc_meta_agree with "H2 H1") as %[? <-].
iFrame "H1". iPureIntro. rewrite /shift_loc /= in Hend. naive_solver lia.
- iIntros "H". iDestruct "H" as (id al ????) "#H".
iSplit; iExists id, al; iFrame "H"; iPureIntro; split_and! => //=; lia.
......@@ -387,7 +389,7 @@ Section loc_in_bounds.
Proof.
rewrite loc_in_bounds_eq.
iIntros "Hb ((?&?&Hctx&?)&?)". iDestruct "Hb" as (id al ????) "Hb".
iDestruct (alloc_range_lookup with "Hctx Hb") as %[al' [?[??]]].
iDestruct (alloc_meta_lookup with "Hctx Hb") as %[al' [?[[??]?]]].
iExists id, al'. iPureIntro. unfold allocation_in_range, al_end in *.
naive_solver lia.
Qed.
......@@ -524,6 +526,10 @@ Section heap.
by iDestruct (heap_mapsto_mbyte_agree with "[$]") as %->.
Qed.
Lemma heap_mapsto_layout_has_layout l ly :
l |ly| - l `has_layout_loc` ly.
Proof. iIntros "(% & % & % & ?)". done. Qed.
Lemma heap_alloc_st l h v aid :
l.1 = ProvAlloc (Some aid)
heap_range_free h l.2 (length v)
......@@ -555,12 +561,12 @@ Section heap.
al.(al_start) = l.2
al.(al_len) = length v
allocation_in_range al
alloc_range id al -
alloc_meta id al -
alloc_alive id (DfracOwn 1) true -
heap_ctx h ==
heap_ctx (heap_alloc l.2 v id h)
l v
freeable l (length v).
freeable l (length v) al.(al_kind).
Proof.
iIntros (Hid Hfree Hstart Hlen Hrange) "#Hr Hal Hctx".
iMod (heap_alloc_st with "Hctx") as "[$ Hl]" => //.
......@@ -568,7 +574,7 @@ Section heap.
rewrite heap_mapsto_mbyte_eq /heap_mapsto_mbyte_def.
iSplitR "Hal"; last first; last iSplit.
- rewrite freeable_eq. iExists id. iFrame. iSplit => //.
by iApply (alloc_range_mono with "Hr").
by iApply (alloc_meta_mono with "Hr").
- rewrite loc_in_bounds_eq. iExists id, al. iFrame "Hr".
rewrite /al_end. iPureIntro. naive_solver lia.
- iApply (big_sepL_impl with "Hl").
......@@ -839,25 +845,25 @@ End alloc_alive.
Section alloc_new_blocks.
Context `{!heapG Σ}.
Lemma heap_alloc_new_block_upd σ1 l v σ2:
alloc_new_block σ1 l v σ2
heap_state_ctx σ1 == heap_state_ctx σ2 l v freeable l (length v).
Lemma heap_alloc_new_block_upd σ1 l v kind σ2:
alloc_new_block σ1 kind l v σ2
heap_state_ctx σ1 == heap_state_ctx σ2 l v freeable l (length v) kind.
Proof.
move => []; clear. move => σ l aid v alloc Haid ???; subst alloc.
move => []; clear. move => σ l aid kind v alloc Haid ???; subst alloc.
iIntros "Hctx". iDestruct "Hctx" as (Hinv) "(Hhctx&Hrctx&Hsctx)".
iMod (alloc_range_alloc with "Hrctx") as "[$ #Hb]" => //.
iMod (alloc_meta_alloc with "Hrctx") as "[$ #Hb]" => //.
iMod (alloc_alive_alloc with "Hsctx") as "[$ Hs]" => //.
iDestruct (alloc_range_to_loc_in_bounds l aid (length v) with "[Hb]")
iDestruct (alloc_meta_to_loc_in_bounds l aid (length v) with "[Hb]")
as "#Hinb" => //; [done|..].
iMod (heap_alloc with "Hb Hs Hhctx") as "[Hhctx [Hv Hal]]" => //.
iModIntro. iFrame. iPureIntro. by eapply alloc_new_block_invariant.
Qed.
Lemma heap_alloc_new_blocks_upd σ1 ls vs σ2:
alloc_new_blocks σ1 ls vs σ2
Lemma heap_alloc_new_blocks_upd σ1 ls vs kind σ2:
alloc_new_blocks σ1 kind ls vs σ2
heap_state_ctx σ1 ==
heap_state_ctx σ2
[ list] l; v ls; vs, l v freeable l (length v).
[ list] l; v ls; vs, l v freeable l (length v) kind.
Proof.
move => alloc.
iInduction alloc as [σ|] "IH"; first by iIntros "$ !>". iIntros "Hσ".
......@@ -869,27 +875,27 @@ End alloc_new_blocks.
Section free_blocks.
Context `{!heapG Σ}.
Lemma heap_free_block_upd σ1 l ly:
Lemma heap_free_block_upd σ1 l ly kind:
l |ly| -
freeable l (ly_size ly) -
heap_state_ctx σ1 == σ2, free_block σ1 l ly σ2 heap_state_ctx σ2.
freeable l (ly_size ly) kind -
heap_state_ctx σ1 == σ2, free_block σ1 kind l ly σ2 heap_state_ctx σ2.
Proof.
iIntros "Hl Hfree (Hinv&Hhctx&Hrctx&Hsctx)". iDestruct "Hinv" as %Hinv.
rewrite freeable_eq. iDestruct "Hfree" as (aid Haid) "[#Hrange Hkill]".
iDestruct "Hl" as (v Hv ?) "Hl".
iDestruct (alloc_alive_lookup with "Hsctx Hkill") as %[[???] [??]].
iDestruct (alloc_range_lookup with "Hrctx Hrange") as %[al'' [?[??]]]. simplify_eq/=.
iDestruct (alloc_alive_lookup with "Hsctx Hkill") as %[[????k] [??]].
iDestruct (alloc_meta_lookup with "Hrctx Hrange") as %[al'' [?[[??]?]]]. simplify_eq/=.
iDestruct (heap_mapsto_lookup_1 (λ st : lock_state, st = RSt 0) with "Hhctx Hl") as %? => //.
iExists _. iSplitR. { iPureIntro. by econstructor. }
iMod (heap_free_free with "Hhctx Hl") as "Hhctx". rewrite Hv. iFrame => /=.
iMod (alloc_alive_kill _ _ ({| al_start := l.2; al_len := ly_size ly; al_alive := true |}) with "Hsctx Hkill") as "[$ Hd]".
erewrite alloc_range_ctx_same_range; [iFrame |done..].
iMod (alloc_alive_kill _ _ ({| al_start := l.2; al_len := ly_size ly; al_alive := true; al_kind := k |}) with "Hsctx Hkill") as "[$ Hd]".
erewrite alloc_meta_ctx_same_range; [iFrame |done..].
iPureIntro. eapply free_block_invariant => //. by eapply FreeBlock.
Qed.
Lemma heap_free_blocks_upd ls σ1:
([ list] l ls, l.1 |l.2| freeable l.1 (ly_size l.2)) -
heap_state_ctx σ1 == σ2, free_blocks σ1 ls σ2 heap_state_ctx σ2.
Lemma heap_free_blocks_upd ls σ1 kind:
([ list] l ls, l.1 |l.2| freeable l.1 (ly_size l.2) kind ) -
heap_state_ctx σ1 == σ2, free_blocks σ1 kind ls σ2 heap_state_ctx σ2.
Proof.
iInduction ls as [|[l ly] ls] "IH" forall (σ1).
{ iIntros "_ ? !>". iExists σ1. iFrame. iPureIntro. by constructor. }
......
......@@ -185,11 +185,18 @@ Qed.
(** ** Representation of allocations. *)
(** An allocation can either be a stack allocation or a heap allocation. *)
Inductive alloc_kind : Set :=
| HeapAlloc
| StackAlloc
| GlobalAlloc.
Record allocation :=
Allocation {
al_start : Z; (* First valid address. *)
al_len : nat; (* Number of allocated byte. *)
al_alive : bool; (* Is the allocation still alive. *)
al_start : Z; (* First valid address. *)
al_len : nat; (* Number of allocated byte. *)
al_alive : bool; (* Is the allocation still alive. *)
al_kind : alloc_kind; (* On the heap or on the stack? *)
}.
Definition al_end (al : allocation) : Z :=
......@@ -201,7 +208,7 @@ Definition alloc_same_range (al1 al2 : allocation) : Prop :=
al1.(al_start) = al2.(al_start) al1.(al_len) = al2.(al_len).
Definition killed (al : allocation) : allocation :=
{| al_start := al.(al_start); al_len := al.(al_len); al_alive := false; |}.
{| al_start := al.(al_start); al_len := al.(al_len); al_alive := false; al_kind := al.(al_kind) |}.
(** Smallest allocatable address (we reserve 0 for NULL). *)
Definition min_alloc_start : Z := 1.
......@@ -262,6 +269,8 @@ Proof. rewrite /valid_ptr => ?. apply: heap_state_loc_in_bounds_has_alloc_id. na
Definition addr_in_range_alloc (a : addr) (aid : alloc_id) (st : heap_state) : Prop :=
alloc, st.(hs_allocs) !! aid = Some alloc a alloc.
Global Instance alloc_kind_eq_dec : EqDecision alloc_kind.
Proof. solve_decision. Qed.
Global Instance allocation_eq_dec : EqDecision (allocation).
Proof. solve_decision. Qed.
Global Instance alloc_id_alive_dec aid st : Decision (alloc_id_alive aid st).
......@@ -474,57 +483,57 @@ Arguments mem_cast : simpl never.
(** ** Allocation and deallocation. *)
Inductive alloc_new_block : heap_state loc val heap_state Prop :=
| AllocNewBlock σ l aid v:
let alloc := Allocation l.2 (length v) true in
Inductive alloc_new_block : heap_state alloc_kind loc val heap_state Prop :=
| AllocNewBlock σ l aid kind v:
let alloc := Allocation l.2 (length v) true kind in
l.1 = ProvAlloc (Some aid)
σ.(hs_allocs) !! aid = None
allocation_in_range alloc
heap_range_free σ.(hs_heap) l.2 (length v)
alloc_new_block σ l v {|
alloc_new_block σ kind l v {|
hs_heap := heap_alloc l.2 v aid σ.(hs_heap);
hs_allocs := <[aid := alloc]> σ.(hs_allocs);
|}.
Inductive alloc_new_blocks : heap_state list loc list val heap_state Prop :=
| AllocNewBlock_nil σ :
alloc_new_blocks σ [] [] σ
| AllocNewBlock_cons σ σ' σ'' l v ls vs :
alloc_new_block σ l v σ'
alloc_new_blocks σ' ls vs σ''
alloc_new_blocks σ (l :: ls) (v :: vs) σ''.
Inductive free_block : heap_state loc layout heap_state Prop :=
| FreeBlock σ l aid ly v:
let al_alive := Allocation l.2 ly.(ly_size) true in
let al_dead := Allocation l.2 ly.(ly_size) false in
Inductive alloc_new_blocks : heap_state alloc_kind list loc list val heap_state Prop :=
| AllocNewBlock_nil σ kind :
alloc_new_blocks σ kind [] [] σ
| AllocNewBlock_cons σ σ' σ'' l v ls kind vs :
alloc_new_block σ kind l v σ'
alloc_new_blocks σ' kind ls vs σ''
alloc_new_blocks σ kind (l :: ls) (v :: vs) σ''.
Inductive free_block : heap_state alloc_kind loc layout heap_state Prop :=
| FreeBlock σ l aid ly kind v:
let al_alive := Allocation l.2 ly.(ly_size) true kind in
let al_dead := Allocation l.2 ly.(ly_size) false kind in
l.1 = ProvAlloc (Some aid)
σ.(hs_allocs) !! aid = Some al_alive
length v = ly.(ly_size)
heap_lookup_loc l v (λ st, st = RSt 0%nat) σ.(hs_heap)
free_block σ l ly {|
free_block σ kind l ly {|
hs_heap := heap_free l.2 ly.(ly_size) σ.(hs_heap);
hs_allocs := <[aid := al_dead]> σ.(hs_allocs);
|}.
Inductive free_blocks : heap_state list (loc * layout) heap_state Prop :=
| FreeBlocks_nil σ :
free_blocks σ [] σ
| FreeBlocks_cons σ σ' σ'' l ly ls :
free_block σ l ly σ'
free_blocks σ' ls σ''
free_blocks σ ((l, ly) :: ls) σ''.
Inductive free_blocks : heap_state alloc_kind list (loc * layout) heap_state Prop :=
| FreeBlocks_nil σ kind :
free_blocks σ kind [] σ
| FreeBlocks_cons σ σ' σ'' l ly kind ls :
free_block σ kind l ly σ'
free_blocks σ' kind ls σ''
free_blocks σ kind ((l, ly) :: ls) σ''.
Lemma free_block_inj hs l ly hs1 hs2:
free_block hs l ly hs1 free_block hs l ly hs2 hs1 = hs2.
Lemma free_block_inj hs l ly kind hs1 hs2:
free_block hs kind l ly hs1 free_block hs kind l ly hs2 hs1 = hs2.
Proof. destruct l. inversion 1; simplify_eq. by inversion 1; simplify_eq/=. Qed.
Lemma free_blocks_inj hs1 hs2 hs ls:
free_blocks hs ls hs1 free_blocks hs ls hs2 hs1 = hs2.
Lemma free_blocks_inj hs1 hs2 hs kind ls:
free_blocks hs kind ls hs1 free_blocks hs kind ls hs2 hs1 = hs2.
Proof.
move Heq: {1}(hs) => hs' Hb.
elim: Hb hs Heq. { move => ?? ->. by inversion 1. }
move => ?????? Hb1 ? IH ??.
elim: Hb hs Heq. { move => ??? ->. by inversion 1. }
move => ??????? Hb1 ? IH ??.
inversion 1; simplify_eq. apply: IH; [|done].
by apply: free_block_inj.
Qed.
......@@ -580,25 +589,25 @@ Definition heap_state_invariant (st : heap_state) : Prop :=
(** ** Lemmas about the heap state invariant. *)
Lemma heap_state_alloc_alive_free_disjoint σ id a n b alloc:
Lemma heap_state_alloc_alive_free_disjoint σ id a n b kind alloc:
heap_state_alloc_alive_in_heap σ
alloc_id_alive id σ
heap_range_free σ.(hs_heap) a n
σ.(hs_allocs) !! id = Some alloc
Allocation a n b ## alloc.
Allocation a n b kind ## alloc.
Proof.
move => Hin_heap Halive Hfree Hal p Hp1 Hp2.
apply (Hin_heap _ _ Hal Halive) in Hp2 as [? Hp2].
rewrite Hfree in Hp2; first done. apply Hp1.
Qed.
Lemma alloc_new_block_invariant σ1 σ2 l v :
alloc_new_block σ1 l v σ2
Lemma alloc_new_block_invariant σ1 σ2 l v kind :
alloc_new_block σ1 kind l v σ2
heap_state_invariant σ1
heap_state_invariant σ2.
Proof.
move => []; clear.
move => σ1 l aid v alloc Haid Hfresh Halloc Hrange H.
move => σ1 l aid kind v alloc Haid Hfresh Halloc Hrange H.
destruct H as (Hi1&Hi2&Hi3&Hi4&Hi5). split_and!.
- move => a [id??] /= Ha. destruct (decide (aid = id)) as [->|Hne].
+ exists alloc. split => /=; first by rewrite lookup_insert.
......@@ -650,22 +659,22 @@ Proof.
eapply (Hi5 _ _ Hal); [by eexists | done |..].
Qed.
Lemma alloc_new_blocks_invariant σ1 σ2 ls vs :
alloc_new_blocks σ1 ls vs σ2
Lemma alloc_new_blocks_invariant σ1 σ2 ls vs kind :
alloc_new_blocks σ1 kind ls vs σ2
heap_state_invariant σ1
heap_state_invariant σ2.
Proof.
elim => [] // ??????? Hb Hbs IH H.
elim => [] // ???????? Hb Hbs IH H.
apply IH. by eapply alloc_new_block_invariant.
Qed.
Lemma free_block_invariant σ1 σ2 l ly:
free_block σ1 l ly σ2
Lemma free_block_invariant σ1 σ2 l ly kind :
free_block σ1 kind l ly σ2
heap_state_invariant σ1
heap_state_invariant σ2.
Proof.
move => []; clear.
move => σ l aid ly v al_a al_d Haid Hal_a Hlen Hlookup H.
move => σ l aid ly kind v al_a al_d Haid Hal_a Hlen Hlookup H.
destruct H as (Hi1&Hi2&Hi3&Hi4&Hi5). split_and!.
- move => a hc /= Hhc.
assert (¬ (l.2 a < l.2 + length v)) as Hnot_in.
......@@ -712,12 +721,12 @@ Proof.
erewrite elem_of_disjoint in Hdisj. by eapply Hdisj.
Qed.
Lemma free_blocks_invariant σ1 σ2 ls:
free_blocks σ1 ls σ2
Lemma free_blocks_invariant σ1 σ2 ls kind :
free_blocks σ1 kind ls σ2
heap_state_invariant σ1
heap_state_invariant σ2.
Proof.
elim => [] // ?????? Hb Hbs IH H.
elim => [] // ??????? Hb Hbs IH H.
apply IH. by eapply free_block_invariant.
Qed.
......
......@@ -37,6 +37,7 @@ Inductive expr :=
| Call (f : expr) (args : list expr)
| Concat (es : list expr)
| IfE (ot : op_type) (e1 e2 e3 : expr)
| Alloc (ly : layout) (e : expr)
| SkipE (e : expr)
| StuckE (* stuck expression *)
.
......@@ -53,6 +54,7 @@ Lemma expr_ind (P : expr → Prop) :
( (f : expr) (args : list expr), P f Forall P args P (Call f args))
( (es : list expr), Forall P es P (Concat es))
( (ot : op_type) (e1 e2 e3 : expr), P e1 P e2 P e3 P (IfE ot e1 e2 e3))
( (ly : layout) (e : expr), P e P (Alloc ly e))
( (e : expr), P e P (SkipE e))
(P StuckE)