Commit 5d1b43a8 authored by Michael Sammler's avatar Michael Sammler
Browse files

More provenances

parent 102057c0
Pipeline #48885 failed with stage
in 12 minutes and 54 seconds
......@@ -83,7 +83,7 @@ int* roundtrip1(int* p){
// Roundtrip cast with dummy arithmetic.
[[rc::parameters("p : loc")]]
[[rc::args("p @ &own<int<i32>>")]]
[[rc::exists("id : {option alloc_id}")]] // ← Only ∃ on provenance.
[[rc::exists("id : prov")]] // ← Only ∃ on provenance.
[[rc::returns("{(id, p.2)} @ &own<place<{(id, p.2)}>>")]]
int* roundtrip2(int* p){
uintptr_t i = (uintptr_t) p;
......
......@@ -47,7 +47,7 @@ Section spec.
(* Specifications for function [roundtrip2]. *)
Definition type_of_roundtrip2 :=
fn( p : loc; (p @ (&own (int (i32)))); True)
id : (option alloc_id), (((id, p.2)) @ (&own (place ((id, p.2))))); True.
id : prov, (((id, p.2)) @ (&own (place ((id, p.2))))); True.
(* Specifications for function [roundtrip3]. *)
Definition type_of_roundtrip3 :=
......
......@@ -26,7 +26,7 @@ Class heapG Σ := HeapG {
heap_alloc_range_map_name : gname;
heap_alloc_alive_map_inG :> ghost_mapG Σ alloc_id bool;
heap_alloc_alive_map_name : gname;
heap_fntbl_inG :> ghost_mapG Σ loc function;
heap_fntbl_inG :> ghost_mapG Σ addr function;
heap_fntbl_name : gname;
}.
......@@ -74,7 +74,7 @@ Section definitions.
the fact that this allocation is in bounds of allocatable memory. *)
Definition loc_in_bounds_def (l : loc) (n : nat) : iProp Σ :=
(id : alloc_id) (al : allocation),
l.1 = Some id al.(al_start) l.2 l.2 + n al_end 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.
Definition loc_in_bounds_aux : seal (@loc_in_bounds_def). by eexists. Qed.
Definition loc_in_bounds := unseal loc_in_bounds_aux.
......@@ -100,7 +100,7 @@ Section definitions.
Proof. rewrite alloc_alive_eq. by apply _. Qed.
Definition alloc_global (l : loc) : iProp Σ :=
id, l.1 = Some id alloc_alive id DfracDiscarded true.
id, l.1 = ProvAlloc (Some id) alloc_alive id DfracDiscarded true.
Global Instance alloc_global_tl l : Timeless (alloc_global l).
Proof. by apply _. Qed.
Global Instance alloc_global_pers l : Persistent (alloc_global l).
......@@ -111,7 +111,7 @@ Section definitions.
[f] is stored at location [l]. NOTE: we use locations, but do not really
store the code on the actual heap. *)
Definition fntbl_entry_def (l : loc) (f: function) : iProp Σ :=
l [ heap_fntbl_name ] f.
a, l = fn_loc a a [ heap_fntbl_name ] f.
Definition fntbl_entry_aux : seal (@fntbl_entry_def). by eexists. Qed.
Definition fntbl_entry := unseal fntbl_entry_aux.
Definition fntbl_entry_eq : @fntbl_entry = @fntbl_entry_def :=
......@@ -130,7 +130,7 @@ Section definitions.
own heap_heap_name ( {[ l.2 := (q, to_lock_stateR st, to_agree (id, b)) ]}).
Definition heap_mapsto_mbyte_def (l : loc) (q : Qp) (b : mbyte) : iProp Σ :=
id, l.1 = Some id heap_mapsto_mbyte_st (RSt 0) l id q b.
id, l.1 = ProvAlloc (Some id) heap_mapsto_mbyte_st (RSt 0) l id q b.
Definition heap_mapsto_mbyte_aux : seal (@heap_mapsto_mbyte_def). by eexists. Qed.
Definition heap_mapsto_mbyte := unseal heap_mapsto_mbyte_aux.
Definition heap_mapsto_mbyte_eq : @heap_mapsto_mbyte = @heap_mapsto_mbyte_def :=
......@@ -147,7 +147,7 @@ Section definitions.
(** Token witnessing that [l] has an allocation identifier that is alive. *)
Definition alloc_alive_loc_def (l : loc) : iProp Σ :=
( id q, l.1 = Some id alloc_alive id q true)
( id q, l.1 = ProvAlloc (Some id) alloc_alive id q true)
( a q v, v [] heap_mapsto (l.1, a) q v).
Definition alloc_alive_loc_aux : seal (@alloc_alive_loc_def). by eexists. Qed.
Definition alloc_alive_loc := unseal alloc_alive_loc_aux.
......@@ -157,7 +157,7 @@ Section definitions.
(** * Freeable *)
Definition freeable_def (l : loc) (n : nat) : iProp Σ :=
id, l.1 = Some id alloc_range id {| al_start := l.2; al_len := n; al_alive := true |}
id, l.1 = ProvAlloc (Some id) alloc_range id {| al_start := l.2; al_len := n; al_alive := true |}
alloc_alive id (DfracOwn 1) true.
Definition freeable_aux : seal (@freeable_def). by eexists. Qed.
Definition freeable := unseal freeable_aux.
......@@ -175,7 +175,7 @@ Section definitions.
Definition alloc_alive_ctx (ub : allocs) : iProp Σ :=
ghost_map_auth heap_alloc_alive_map_name 1 (to_alloc_alive_map ub).
Definition fntbl_ctx (fns : gmap loc function) : iProp Σ :=
Definition fntbl_ctx (fns : gmap addr function) : iProp Σ :=
ghost_map_auth heap_fntbl_name 1 fns.
Definition heap_state_ctx (st : heap_state) : iProp Σ :=
......@@ -232,8 +232,13 @@ Section fntbl.
Implicit Types E : coPset.
Lemma fntbl_entry_lookup t f fn :
fntbl_ctx t - fntbl_entry f fn - t !! f = Some fn.
Proof. rewrite fntbl_entry_eq. by apply ghost_map_lookup. Qed.
fntbl_ctx t - fntbl_entry f fn - a, f = fn_loc a t !! a = Some fn.
Proof.
rewrite fntbl_entry_eq.
iIntros "Hctx (%a&->&Hentry)".
iDestruct (ghost_map_lookup with "Hctx Hentry") as %?.
by eauto.
Qed.
End fntbl.
Section alloc_range.
......@@ -263,7 +268,7 @@ Section alloc_range.
Qed.
Lemma alloc_range_to_loc_in_bounds l id (n : nat) al:
l.1 = Some id
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.
......@@ -343,7 +348,7 @@ Section loc_in_bounds.
iDestruct "H1" as (id al Hl1 ???) "#H1".
iDestruct "H2" as (?? Hl2 ? Hend ?) "#H2".
move: Hl1 Hl2 => /= Hl1 Hl2. iExists id, al.
unfold al_end in *. simpl in *. simplify_eq.
destruct l. unfold al_end in *. simpl in *. simplify_eq.
iDestruct (alloc_range_agree with "H2 H1") as %[? <-].
iFrame "H1". iPureIntro. rewrite /shift_loc /= in Hend. naive_solver lia.
- iIntros "H". iDestruct "H" as (id al ????) "#H".
......@@ -418,7 +423,7 @@ Section heap.
intros p q. rewrite heap_mapsto_mbyte_eq. iSplit.
- iDestruct 1 as (??) "[H1 H2]". iSplitL "H1"; iExists id; by iSplit.
- iIntros "[H1 H2]". iDestruct "H1" as (??) "H1". iDestruct "H2" as (??) "H2".
simplify_eq. iExists id. iSplit; first done. by iSplitL "H1".
destruct l; simplify_eq/=. iExists _. iSplit; first done. by iSplitL "H1".
Qed.
Global Instance heap_mapsto_mbyte_as_fractional l q v:
......@@ -439,13 +444,13 @@ Section heap.
l {q} v - loc_in_bounds l (length v).
Proof. rewrite heap_mapsto_eq. iIntros "[$ _]". Qed.
Lemma loc_in_bounds_has_alloc_id l n: loc_in_bounds l n - is_Some l.1.
Lemma loc_in_bounds_has_alloc_id l n: loc_in_bounds l n - aid, l.1 = ProvAlloc (Some aid).
Proof.
rewrite loc_in_bounds_eq. iIntros "H". iDestruct "H" as (id ?????) "H".
iPureIntro. by exists id.
Qed.
Lemma heap_mapsto_has_alloc_id l q v : l {q} v - is_Some l.1.
Lemma heap_mapsto_has_alloc_id l q v : l {q} v - aid, l.1 = ProvAlloc (Some aid).
Proof.
iIntros "Hl". iApply loc_in_bounds_has_alloc_id.
by iApply heap_mapsto_loc_in_bounds.
......@@ -519,7 +524,7 @@ Section heap.
Qed.
Lemma heap_alloc_st l h v aid :
l.1 = Some aid
l.1 = ProvAlloc (Some aid)
heap_range_free h l.2 (length v)
heap_ctx h ==
heap_ctx (heap_alloc l.2 v aid h)
......@@ -544,7 +549,7 @@ Section heap.
Qed.
Lemma heap_alloc l h v id al :
l.1 = Some id
l.1 = ProvAlloc (Some id)
heap_range_free h l.2 (length v)
al.(al_start) = l.2
al.(al_len) = length v
......@@ -654,9 +659,9 @@ Section heap.
{ iFrame. by iIntros "!#" (?) "$ !#". }
rewrite ->heap_mapsto_cons_mbyte, heap_mapsto_mbyte_eq.
iDestruct "Hv" as "[Hb [? Hl]]". iDestruct "Hb" as (? Heq) "Hb".
rewrite /heap_lookup_loc Heq.
move: Hat => /= -[[? [? [Hin [?[n ?]]]]] ?]; simplify_eq.
iMod ("IH" with "[] Hh Hl") as "{IH}[Hh IH]" => //.
move: Hat. rewrite /heap_lookup_loc Heq /= => -[[? [? [Hin [?[n ?]]]]] ?]; simplify_eq/=.
iMod ("IH" with "[] Hh Hl") as "{IH}[Hh IH]".
{ iPureIntro => /=. by destruct l; simplify_eq/=. }
iMod (heap_read_mbyte_vs _ 0 1 with "Hh Hb") as "[Hh Hb]".
{ rewrite heap_update_lookup_not_in_range // /shift_loc /=. lia. }
iModIntro. iSplitL "Hh".
......@@ -717,9 +722,9 @@ Section heap.
move: Hlen => -[] Hlen.
rewrite heap_mapsto_cons_mbyte heap_mapsto_mbyte_eq.
iDestruct "Hv" as "[Hb [? Hl]]". iDestruct "Hb" as (? Heq) "Hb".
rewrite /heap_lookup_loc Heq.
move: Hat => /= -[[? [? [Hin [??]]]] ?]; simplify_eq.
iMod ("IH" with "[] [] Hh Hl") as "{IH}[Hh IH]" => //.
move: Hat. rewrite /heap_lookup_loc Heq /= => -[[? [? [Hin [??]]]] ?]; simplify_eq/=.
iMod ("IH" with "[] [] Hh Hl") as "{IH}[Hh IH]"; [|done|].
{ iPureIntro => /=. by destruct l; simplify_eq/=. }
iMod (heap_write_mbyte_vs with "Hh Hb") as "[Hh Hb]".
{ rewrite heap_update_lookup_not_in_range /shift_loc /= ?Hin ?Heq //=. lia. }
iSplitL "Hh". { rewrite /heap_upd /=. erewrite partial_alter_to_insert; first done.
......@@ -737,7 +742,7 @@ Section heap.
Qed.
Lemma heap_free_free_st l h v aid :
l.1 = Some aid
l.1 = ProvAlloc (Some aid)
heap_ctx h ([ list] ib v, heap_mapsto_mbyte_st (RSt 0) (l + i) aid 1 b) ==
heap_ctx (heap_free l.2 (length v) h).
Proof.
......@@ -770,7 +775,7 @@ Section heap.
rewrite heap_mapsto_eq /heap_mapsto_def. iDestruct "Hl" as "[_ Hl]".
iApply (big_sepL_impl with "Hl"). iIntros (???) "!> H".
rewrite heap_mapsto_mbyte_eq /heap_mapsto_mbyte_def /=.
iDestruct "H" as (?) "[% H]". by simplify_eq.
iDestruct "H" as (?) "[% H]". by destruct l; simplify_eq/=.
Qed.
End heap.
......
......@@ -50,18 +50,18 @@ Fixpoint heap_update (a : addr) (v : val) (faid : option alloc_id → alloc_id)
Definition heap_lookup_loc (l : loc) (v : val) (Plk : lock_state Prop)
(h : heap) : Prop :=
heap_lookup l.2 v (λ aid, l.1 = Some aid) Plk h.
heap_lookup l.2 v (λ aid, l.1 = ProvAlloc (Some aid)) Plk h.
Definition heap_alloc (a : addr) (v : val) (aid : alloc_id) (h : heap) : heap :=
heap_update a v (λ _, aid) (λ _, RSt 0%nat) h.
Definition heap_at (l : loc) (ly : layout) (v : val) (Plk : lock_state Prop)
(h : heap) : Prop :=
is_Some l.1 l `has_layout_loc` ly v `has_layout_val` ly
( aid, l.1 = ProvAlloc (Some aid)) l `has_layout_loc` ly v `has_layout_val` ly
heap_lookup_loc l v Plk h.
Definition heap_upd l v flk h :=
heap_update l.2 v (default (default dummy_alloc_id l.1)) flk h.
Definition heap_upd (l : loc) v flk h :=
heap_update l.2 v (default (default dummy_alloc_id (prov_alloc_id l.1))) flk h.
(** Predicate stating that the [n] first bytes from address [a] in [h] have
not been allocated. *)
......@@ -229,14 +229,14 @@ Definition alloc_id_alive (aid : alloc_id) (st : heap_state) : Prop :=
alloc, st.(hs_allocs) !! aid = Some alloc alloc.(al_alive).
Definition block_alive (l : loc) (st : heap_state) : Prop :=
aid, l.1 = Some aid alloc_id_alive aid st.
aid, l.1 = ProvAlloc (Some aid) alloc_id_alive aid st.
(** The address range between [l] and [l +ₗ n] (included) is in range of the
allocation that contains [l]. Note that we consider the 1-past-the-end
pointer to be in range of an allocation. *)
Definition heap_state_loc_in_bounds (l : loc) (n : nat) (st : heap_state) : Prop :=
alloc_id al,
l.1 = Some alloc_id
l.1 = ProvAlloc (Some alloc_id)
st.(hs_allocs) !! alloc_id = Some al
al.(al_start) l.2
l.2 + n al_end al.
......@@ -252,7 +252,7 @@ Definition addr_in_range_alloc (a : addr) (aid : alloc_id) (st : heap_state) : P
Inductive alloc_new_block : heap_state loc val heap_state Prop :=
| AllocNewBlock σ l aid v:
let alloc := Allocation l.2 (length v) true in
l.1 = Some aid
l.1 = ProvAlloc (Some aid)
σ.(hs_allocs) !! aid = None
allocation_in_range alloc
heap_range_free σ.(hs_heap) l.2 (length v)
......@@ -273,7 +273,7 @@ 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
l.1 = Some aid
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)
......@@ -290,9 +290,17 @@ Inductive free_blocks : heap_state → list (loc * layout) → heap_state → Pr
free_blocks σ' ls σ''
free_blocks σ ((l, ly) :: ls) σ''.
Lemma heap_state_loc_in_bounds_has_alloc_id l n σ:
heap_state_loc_in_bounds l n σ aid, l.1 = ProvAlloc (Some aid).
Proof. rewrite /heap_state_loc_in_bounds. naive_solver. Qed.
Lemma valid_ptr_has_alloc_id l σ:
valid_ptr l σ aid, l.1 = ProvAlloc (Some aid).
Proof. rewrite /valid_ptr => ?. apply: heap_state_loc_in_bounds_has_alloc_id. naive_solver. Qed.
Lemma free_block_inj hs l ly hs1 hs2:
free_block hs l ly hs1 free_block hs l ly hs2 hs1 = hs2.
Proof. inversion 1; simplify_eq. by inversion 1; simplify_eq. Qed.
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.
......
......@@ -95,7 +95,7 @@ Record function := {
(* TODO: put both function and bytes in the same heap or make pointers disjoint *)
Record state := {
st_heap: heap_state;
st_fntbl: gmap loc function;
st_fntbl: gmap addr function;
}.
Definition heap_fmap (f : heap heap) (σ : state) := {|
......@@ -241,24 +241,24 @@ Inductive eval_bin_op : bin_op → op_type → op_type → state → val → val
| EqOpPNull v1 v2 σ l v:
heap_state_loc_in_bounds l 0%nat σ.(st_heap)
val_to_loc v1 = Some l
val_to_Z v2 size_t = Some 0
v2 = NULL
(* TODO ( see below ): Should we really hard code i32 here because of C? *)
i2v (Z_of_bool false) i32 = v
eval_bin_op EqOp PtrOp PtrOp σ v1 v2 v
| NeOpPNull v1 v2 σ l v:
heap_state_loc_in_bounds l 0%nat σ.(st_heap)
val_to_loc v1 = Some l
val_to_Z v2 size_t = Some 0
v2 = NULL
i2v (Z_of_bool true) i32 = v
eval_bin_op NeOp PtrOp PtrOp σ v1 v2 v
| EqOpNullNull v1 v2 σ v:
val_to_Z v1 size_t = Some 0
val_to_Z v2 size_t = Some 0
v1 = NULL
v2 = NULL
i2v (Z_of_bool true) i32 = v
eval_bin_op EqOp PtrOp PtrOp σ v1 v2 v
| NeOpNullNull v1 v2 σ v:
val_to_Z v1 size_t = Some 0
val_to_Z v2 size_t = Some 0
v1 = NULL
v2 = NULL
i2v (Z_of_bool false) i32 = v
eval_bin_op NeOp PtrOp PtrOp σ v1 v2 v
| RelOpPP v1 v2 σ l1 l2 v b op:
......@@ -402,9 +402,10 @@ comparing pointers? (see lambda rust) *)
z1 = z2
expr_step (CAS (IntOp it) (Val v1) (Val v2) (Val v3)) σ []
(Val (val_of_bool true)) (heap_fmap (heap_upd l1 v3 (λ _, RSt 0%nat)) σ) []
| CallS lsa lsv σ hs' hs'' vf vs f rf fn fn' :
| CallS lsa lsv σ hs' hs'' vf vs f rf fn fn' a:
val_to_loc vf = Some f
σ.(st_fntbl) !! f = Some fn
f = fn_loc a
σ.(st_fntbl) !! a = Some fn
length lsa = length fn.(f_args)
length lsv = length fn.(f_local_vars)
(* substitute the variables in fn with the corresponding locations *)
......@@ -421,9 +422,10 @@ comparing pointers? (see lambda rust) *)
(* add used blocks allocations *)
rf = {| rf_fn := fn'; rf_locs := zip lsa fn.(f_args).*2 ++ zip lsv fn.(f_local_vars).*2; |}
expr_step (Call (Val vf) (Val <$> vs)) σ [] (to_rtstmt rf (Goto fn'.(f_init))) {| st_heap := hs''; st_fntbl := σ.(st_fntbl)|} []
| CallFailS σ vf vs f fn:
| CallFailS σ vf vs f fn a:
val_to_loc vf = Some f
σ.(st_fntbl) !! f = Some fn
f = fn_loc a
σ.(st_fntbl) !! a = Some fn
Forall2 has_layout_val vs fn.(f_args).*2
expr_step (Call (Val vf) (Val <$> vs)) σ [] AllocFailed σ []
| ConcatS vs σ:
......
......@@ -427,6 +427,8 @@ Lemma wp_ptr_relop Φ op v1 v2 l1 l2 E b:
WP BinOp op PtrOp PtrOp (Val v1) (Val v2) @ E {{ Φ }}.
Proof.
iIntros (Hv1 Hv2 Hop) "#Hl1 #Hl2 HΦ".
iDestruct (loc_in_bounds_has_alloc_id with "Hl1") as %[??].
iDestruct (loc_in_bounds_has_alloc_id with "Hl2") as %[??].
iApply wp_binop. iIntros (σ) "Hσ".
iAssert valid_ptr l1 σ.(st_heap)%I as %?. {
iApply (alloc_alive_loc_to_valid_ptr with "Hl1 [HΦ] Hσ").
......@@ -438,7 +440,9 @@ Proof.
}
iSplit; first by iPureIntro; eexists _; econstructor.
iDestruct "HΦ" as "(_&_&HΦ)". iIntros "!>" (v' Hstep). iFrame.
inversion Hstep; simplify_eq => //; by move: Hv1 Hv2 => /val_of_to_loc ?/val_of_to_loc?; subst.
inversion Hstep; simplify_eq => //.
all: try rewrite val_to_of_loc in Hv1; simplify_eq.
all: try rewrite val_to_of_loc in Hv2; simplify_eq.
Qed.
Lemma wp_ptr_offset Φ vl l E it o ly vo:
......@@ -688,7 +692,7 @@ Proof.
move => Hf Hly. move: (Hly) => /Forall2_length. rewrite fmap_length => Hlen_vs.
iIntros "Hf HWP". iApply wp_lift_expr_step; first done.
iIntros (σ1) "((%&Hhctx&Hbctx)&Hfctx)".
iDestruct (fntbl_entry_lookup with "Hfctx Hf") as %Hfn. iModIntro.
iDestruct (fntbl_entry_lookup with "Hfctx Hf") as %[a [? Hfn]]; subst. iModIntro.
iSplit; first by eauto 10 using CallFailS.
iIntros (??[??]? Hstep _) "!>". inv_expr_step; last first. {
(* Alloc failure case. *)
......
......@@ -17,10 +17,43 @@ Definition addr := Z.
Definition alloc_id := Z.
Definition dummy_alloc_id : alloc_id := 0.
(** Provenances *)
Inductive prov :=
| ProvNull
| ProvAlloc (aid : option alloc_id)
| ProvFnPtr.
Global Instance prov_inhabited : Inhabited prov := populate ProvNull.
Global Instance prov_eq_dec : EqDecision prov.
Proof. solve_decision. Qed.
Global Instance prov_countable : Countable prov.
Proof.
refine (inj_countable'
(λ prov,
match prov with
| ProvNull => inl (inl tt)
| ProvAlloc aid => inl (inr aid)
| ProvFnPtr => inr tt
end
)
(λ prov,
match prov with
| inl (inl _) => ProvNull
| inl (inr aid) => ProvAlloc aid
| inr _ => ProvFnPtr
end) _); abstract by intros [].
Defined.
Definition prov_alloc_id (p : prov) : option alloc_id :=
if p is ProvAlloc aid then aid else None.
(** Memory location. *)
Definition loc : Set := option alloc_id * addr.
Definition loc : Set := prov * addr.
Bind Scope loc_scope with loc.
Definition fn_loc (a : addr) : loc := (ProvFnPtr, a).
Definition NULL_loc : loc := (ProvNull, 0).
Typeclasses Opaque NULL_loc fn_loc.
(** Shifts location [l] by offset [z]. *)
Definition shift_loc (l : loc) (z : Z) : loc := (l.1, l.2 + z).
Notation "l +ₗ z" := (shift_loc l%L z%Z)
......
......@@ -150,9 +150,7 @@ Definition void_layout : layout := {| ly_size := 0; ly_align_log := 0 |}.
Definition void_ptr : layout := {| ly_size := bytes_per_addr; ly_align_log := bytes_per_addr_log |}.
Notation "'void*'" := (void_ptr).
Definition NULL : val := i2v 0 size_t.
Definition VOID : val := [].
Typeclasses Opaque NULL.
Definition field_list := list (option var_name * layout).
......
......@@ -44,6 +44,9 @@ Definition val_to_loc_n (n : nat) (v : val) : option loc :=
Definition val_to_loc : val option loc :=
val_to_loc_n bytes_per_addr.
Definition NULL : val := val_of_loc NULL_loc.
Typeclasses Opaque NULL.
Lemma val_of_loc_n_length n l:
length (val_of_loc_n n l) = n.
Proof.
......@@ -93,6 +96,9 @@ Proof.
apply val_to_loc_n_length.
Qed.
Global Instance val_of_loc_inj : Inj (=) (=) val_of_loc.
Proof. move => x y Heq. have := val_to_of_loc x. have := val_to_of_loc y. rewrite Heq. by simplify_eq. Qed.
Typeclasses Opaque val_of_loc_n val_to_loc_n val_of_loc val_to_loc.
Arguments val_of_loc : simpl never.
Arguments val_to_loc : simpl never.
......@@ -328,7 +334,7 @@ Definition int_repr_to_Z (i : int_repr) : Z :=
Definition int_repr_to_loc (i : int_repr) : loc :=
match i with
| IRInt z => (None, z)
| IRInt z => (ProvAlloc None, z)
| IRLoc l => l
end.
......
......@@ -524,6 +524,7 @@ Ltac liTrue :=
Ltac liFalse :=
lazymatch goal with
| |- envs_entails _ False => exfalso; shelve
| |- False => shelve
end.
......
......@@ -12,7 +12,7 @@ Class typePreG Σ := PreTypeG {
type_heap_heap_inG :> inG Σ (authR heapUR);
type_heap_alloc_range_map_inG :> ghost_mapG Σ alloc_id (Z * nat);
type_heap_alloc_alive_map_inG :> ghost_mapG Σ alloc_id bool;
type_heap_fntbl_inG :> ghost_mapG Σ loc function;
type_heap_fntbl_inG :> ghost_mapG Σ addr function;
}.
Definition typeΣ : gFunctors :=
......@@ -20,7 +20,7 @@ Definition typeΣ : gFunctors :=
GFunctor (constRF (authR heapUR));
ghost_mapΣ alloc_id (Z * nat);
ghost_mapΣ alloc_id bool;
ghost_mapΣ loc function].
ghost_mapΣ addr function].
Instance subG_typePreG {Σ} : subG typeΣ Σ typePreG Σ.
Proof. solve_inG. Qed.
......@@ -30,20 +30,20 @@ Definition initial_prog (main : loc) : runtime_expr :=
Definition initial_heap_state :=
{| hs_heap := ; hs_allocs := ; |}.
Definition initial_state (fns : gmap loc function) :=
Definition initial_state (fns : gmap addr function) :=
{| st_heap := initial_heap_state; st_fntbl := fns; |}.
Definition main_type `{!typeG Σ} (P : iProp Σ) :=
fn( () : (); P) () : (), int i32; True.
(** * The main adequacy lemma *)
Lemma refinedc_adequacy Σ `{!typePreG Σ} (thread_mains : list loc) (fns : gmap loc function) (gls : list loc) (gvs : list val.val) n t2 σ2 κs hs σ:
Lemma refinedc_adequacy Σ `{!typePreG Σ} (thread_mains : list loc) (fns : gmap addr function) (gls : list loc) (gvs : list val.val) n t2 σ2 κs hs σ:
alloc_new_blocks initial_heap_state gls gvs hs
σ = {| st_heap := hs; st_fntbl := fns; |}
( {HtypeG : typeG Σ}, gl gt,
let Hglobals : globalG Σ := {| global_locs := gl; global_initialized_types := gt; |} in
([ list] l; v gls; gvs, l v) -
([ map] kqsfns, fntbl_entry k qs) ={}=
([ map] kqsfns, fntbl_entry (fn_loc k) qs) ={}=
[ list] main thread_mains, P, main ◁ᵥ main @ function_ptr (main_type P) P)
nsteps (Λ := c_lang) n (initial_prog <$> thread_mains, σ) κs (t2, σ2)
e2, e2 t2 not_stuck e2 σ2.
......@@ -66,10 +66,10 @@ Proof.
by iFrame.
}
rewrite big_sepL2_sep. iDestruct "Hmt" as "[Hmt Hfree]".
iAssert (|==> [ map] kqs fns, fntbl_entry k qs)%I with "[Hfm]" as ">Hfm". {
iAssert (|==> [ map] kqs fns, fntbl_entry (fn_loc k) qs)%I with "[Hfm]" as ">Hfm". {
iApply big_sepM_bupd. iApply (big_sepM_impl with "Hfm").
iIntros "!>" (???) "Hm". rewrite fntbl_entry_eq.
by iApply ghost_map_elem_persist.
iExists _. iSplitR; [done|]. by iApply ghost_map_elem_persist.
}
iMod (Hwp with "Hmt Hfm") as "Hmains".
......@@ -86,14 +86,14 @@ Proof.
Qed.
(** * Helper functions for using the adequacy lemma *)
Definition fn_lists_to_fns (locs : list loc) (fns : list function) : gmap loc function :=
list_to_map (zip locs fns).
Definition fn_lists_to_fns (addrs : list addr) (fns : list function) : gmap addr function :=
list_to_map (zip addrs fns).
Lemma fn_lists_to_fns_cons `{!refinedcG Σ} loc fn locs fns :