Commit ead93333 authored by Robbert Krebbers's avatar Robbert Krebbers

Use `Z`s for pointer offsets, makes thing more uniform and supports pointer subtraction.

parent a249c071
......@@ -21,5 +21,4 @@ theories/tests/swap.v
theories/tests/fact.v
theories/tests/memcpy.v
theories/tests/gcd.v
theories/tests/binop.v
# theories/tests/lists.v
......@@ -158,12 +158,15 @@ Notation "~ᶜ e" := (a_un_op NegOp e%E) (at level 20, right associativity) : ex
Notation "e1 +∗ᶜ e2" := (a_bin_op PtrPlusOp e1%E e2%E) (at level 50) : expr_scope.
Notation "e1 <∗ᶜ e2" := (a_bin_op PtrLtOp e1%E e2%E) (at level 70) : expr_scope.
Definition int_of_val (v : val) : option Z :=
match v with LitV (LitInt x) => Some x | _ => None end.
Definition cbin_op_eval (op : cbin_op) (v1 v2 : val) : option val :=
match op with
| CBinOp op' => bin_op_eval op' v1 v2
| PtrPlusOp =>
cl cloc_of_val v1;
o offset_of_val v2;
o int_of_val v2;
Some (cloc_to_val (cloc_plus cl o))
| PtrLtOp =>
cl1 cloc_of_val v1;
......@@ -187,10 +190,11 @@ Section proofs.
Lemma a_alloc_spec R Φ Ψ1 Ψ2 e1 e2 :
AWP e1 @ R {{ Ψ1 }} -
AWP e2 @ R {{ Ψ2 }} -
( v1 v2, Ψ1 v1 - Ψ2 v2 - n : nat,
( v1 v2, Ψ1 v1 - Ψ2 v2 - n : Z,
v1 = #n
l, l C replicate n v2 - Φ (cloc_to_val l)) -
AWP alloc (e1, e2) @ R {{ Φ }}.
(0 n)%Z
l, l C replicate (Z.to_nat n) v2 - Φ (cloc_to_val l)) -
AWP alloc(e1, e2) @ R {{ Φ }}.
Proof.
iIntros "H1 H2 HΦ".
awp_apply (a_wp_awp with "H2"); iIntros (v2) "H2".
......@@ -198,14 +202,15 @@ Section proofs.
awp_lam. awp_pures.
iApply awp_bind. iApply (awp_par with "H1 H2").
iIntros "!>" (w1 w2) "H1 H2 !>". awp_pures.
iDestruct ("HΦ" with "H1 H2") as (n ->) "HΦ".
iDestruct ("HΦ" with "H1 H2") as (n -> ?) "HΦ".
iApply awp_atomic_env.
iIntros (env). iDestruct 1 as (X σ HX) "[Hlocks Hσ]". iIntros "$". wp_pures.
iEval (rewrite -(Z2Nat.id n) //).
wp_apply (lreplicate_spec with "[//]"); iIntros (ll Hll).
wp_alloc l as "Hl".
iMod (full_locking_heap_alloc_upd with "Hσ Hl") as (?) "[Hσ Hl]"; first done.
wp_pures. iIntros "!>". rewrite cloc_to_val_eq.
iSplitL "Hlocks Hσ"; [|by iApply ("HΦ" $! (MkCloc l 0))].
iSplitL "Hlocks Hσ"; [|by iApply ("HΦ" $! (CLoc l 0))].
iExists X, _. iFrame.
iIntros "!%". intros w Hw. destruct (HX _ Hw) as (cl&Hcl&Hin).
exists cl; split; first done. by rewrite locked_locs_alloc_heap.
......@@ -228,6 +233,7 @@ Section proofs.
iApply awp_atomic_env.
iIntros (env). iDestruct 1 as (X σ HX) "[Hlocks Hσ]". iIntros "HR".
iDestruct (full_locking_heap_unlocked with "Hl Hσ") as %Hw1.
iDestruct (mapsto_offset_non_neg with "Hl") as %?.
assert (cloc_to_val cl X) as HclX.
{ intros Hcl. destruct (HX _ Hcl) as (cl'&[=]%cloc_to_of_val&?). naive_solver. }
rewrite cloc_to_val_eq in HclX.
......@@ -235,8 +241,9 @@ Section proofs.
wp_pures. rewrite cloc_to_val_eq. wp_pures.
wp_apply (mset_add_spec with "[$]"); first done.
iIntros "Hlocks /="; wp_pures.
wp_load.
wp_apply (linsert_spec with "[//]"); [eauto|]; iIntros (ll' Hl').
wp_load; wp_match.
iEval (rewrite -(Z2Nat.id (cloc_offset cl)) //).
wp_apply (linsert_spec with "[//]"); [eauto|]. iIntros (ll' Hl').
iApply wp_fupd. wp_store.
iMod ("Hclose" $! _ LLvl with "[//] Hl") as "[Hσ Hl]".
iIntros "!> !> {$HR}". iSplitL "Hlocks Hσ"; last by iApply "HΦ".
......@@ -255,6 +262,7 @@ Section proofs.
awp_apply (a_wp_awp with "H"); iIntros (v) "H". awp_lam. awp_pures.
iApply awp_bind. iApply (awp_wand with "H"). clear v.
iIntros (v). iDestruct 1 as (cl q w ->) "[Hl HΦ]". awp_pures.
iDestruct (mapsto_offset_non_neg with "Hl") as %?.
iApply awp_atomic_env. iIntros (env) "Henv HR".
iDestruct "Henv" as (X σ HX) "[Hlocks Hσ]".
iDestruct (full_locking_heap_unlocked with "Hl Hσ") as %Hv.
......@@ -266,7 +274,9 @@ Section proofs.
wp_apply wp_assert. wp_apply (mset_member_spec with "Hlocks"); iIntros "Hlocks /=".
rewrite bool_decide_false //.
wp_op. iSplit; first done. iNext; wp_seq.
wp_load; wp_match. wp_apply (llookup_spec with "[//]"); [done|]; iIntros "_".
wp_load; wp_match.
iEval (rewrite -(Z2Nat.id (cloc_offset cl)) //).
wp_apply (llookup_spec with "[//]"); [done|]; iIntros "_".
iDestruct ("Hclose" with "Hl") as "[Hσ Hl]".
iIntros "!> {$HR}". iSplitL "Hlocks Hσ"; last by iApply "HΦ".
iExists X, _. by iFrame.
......@@ -389,7 +399,7 @@ Section proofs.
Lemma a_ptr_plus_spec R Φ Ψ2 e1 e2 :
AWP e2 @ R {{ Ψ2 }} -
AWP e1 @ R {{ v1, v2, Ψ2 v2 - cl (n : nat),
AWP e1 @ R {{ v1, v2, Ψ2 v2 - cl (n : Z),
v1 = cloc_to_val cl
v2 = #n
Φ (cloc_to_val (cloc_plus cl n)) }} -
......@@ -402,7 +412,7 @@ Section proofs.
iIntros "!>" (v1 v2) "Hv1 Hv2 !>". awp_pures.
iDestruct ("Hv1" with "Hv2") as (cl n -> ->) "HΦ /=".
rewrite cloc_to_val_eq.
awp_pures. iApply awp_ret. iApply wp_value. by rewrite -Nat2Z.inj_add.
awp_pures. iApply awp_ret. by iApply wp_value.
Qed.
Lemma a_ptr_lt_spec R Φ Ψ1 e1 e2 :
......@@ -422,8 +432,7 @@ Section proofs.
rewrite cloc_to_val_eq /cloc_lt /=. awp_pures.
case_bool_decide as Hp; subst.
- rewrite (bool_decide_true (#ql = #ql)) //. awp_pures.
iApply awp_ret. iApply wp_value.
rewrite (bool_decide_iff (pi < qi) (pi < qi)%Z); eauto using Nat2Z.inj_lt.
iApply awp_ret. by iApply wp_value.
- rewrite /= bool_decide_false; last congruence.
awp_if. iApply awp_ret. by iApply wp_value.
Qed.
......@@ -446,9 +455,10 @@ Section proofs.
iIntros (v1) "HΨ1"; iIntros (v2) "HΨ2".
iDestruct ("HΦ" with "HΨ1 HΨ2") as (w Hop) "HΦ"; simpl in *.
destruct (cloc_of_val v1) as [cl|] eqn:Hcl; simplify_eq/=.
destruct (offset_of_val v2) as [o|] eqn:Ho; simplify_eq/=.
destruct (int_of_val v2) as [o|] eqn:Ho; simplify_eq/=.
iExists cl,o. iFrame.
rewrite -(cloc_to_of_val v1 cl) // (offset_to_of_val v2 o) //.
rewrite -(cloc_to_of_val v1 cl) //.
by destruct v2; repeat (case_match || simplify_eq/=).
- iApply (a_ptr_lt_spec with "H1").
iApply (awp_wand with "H2").
iIntros (v2) "HΨ2"; iIntros (v1) "HΨ1".
......@@ -468,7 +478,7 @@ Section proofs.
(cl C[LLvl] w - R Φ v)) -
AWP a_pre_bin_op op e1 e2 @ R {{ Φ }}.
Proof.
iIntros "He1 He2 HΦ". rewrite /a_pre_bin_op.
iIntros "He1 He2 HΦ".
awp_apply (a_wp_awp with "He2"); iIntros (a2) "Ha2".
awp_apply (a_wp_awp with "He1"); iIntros (a1) "Ha1". awp_lam; awp_pures.
iApply awp_bind. iApply (awp_par with "Ha1 Ha2"). iNext.
......
This diff is collapsed.
......@@ -7,7 +7,7 @@ Section memcpy.
Definition memcpy : val := λ: "arg",
"p" ←ᶜ a_alloc 1 (a_ret (Fst "arg"));;
"q" ←ᶜ a_alloc 1 (a_ret (Fst (Snd "arg")));;
let: "n" := Snd (Snd "arg") in
"n" ←ᶜ a_ret (Snd (Snd "arg"));;
"pend" ←ᶜ ∗ᶜ (a_ret "p") +∗ᶜ (a_ret "n");;
while (∗ᶜ (a_ret "p") <∗ᶜ a_ret "pend") {
(a_ret "p" += 1) = ∗ᶜ(a_ret "q" += 1)
......
......@@ -5,7 +5,7 @@ Definition known_locs := list cloc.
(* RK: We should also record an offset for unknown locations, ideally. *)
Inductive dloc :=
| dLoc : nat nat dloc (* index * offset *)
| dLoc : nat Z dloc (* index * offset *)
| dLocUnknown : cloc dloc.
Instance dloc_eq_dec : EqDecision dloc.
......@@ -172,13 +172,8 @@ Lemma dptr_plus_eval_correct E dv1 dv2 w :
dptr_plus_eval E dv1 dv2 = Some w
cbin_op_eval PtrPlusOp (dval_interp E dv1) (dval_interp E dv2) = Some (dval_interp E w).
Proof.
destruct dv1 as [?|??|[??|]|u1],dv2 as [[]|??|?|u2]; try naive_solver.
rewrite /cbin_op_eval /=.
destruct d; last by inversion 1.
case_option_guard; inversion 1.
- rewrite cloc_of_to_val /=. do 2 f_equal.
rewrite cloc_plus_plus // Nat2Z.id //.
- simplify_eq/=. omega.
destruct dv1; intros; repeat (simplify_option_eq || case_match); try naive_solver.
by rewrite cloc_of_to_val /= cloc_plus_plus.
Qed.
Definition dcbin_op_eval (E: known_locs) (op : cbin_op) (dv1 dv2 : dval) : option dval :=
......@@ -486,7 +481,7 @@ Instance loc_lookup_there l l' E i :
LocLookup E l i LocLookup (l' :: E) l (S i).
Proof. done. Qed.
Class IntoCLocPlus (l : cloc) (k : cloc) (j : nat) :=
Class IntoCLocPlus (l : cloc) (k : cloc) (j : Z) :=
into_cloc_plus : l = cloc_plus k j.
Instance into_cloc_plus_here l : IntoCLocPlus l l 0 | 100.
......
......@@ -808,7 +808,7 @@ Section denv_spec.
eapply denv_wf_lookup_dval_wf in Hwf; last eassumption.
simpl in *.
rewrite (dval_interp_mono E E' dv Hwf Hpre).
rewrite (dloc_interp_mono E E' k _ Hwf' Hpre).
rewrite (dloc_interp_mono E E' k 0 Hwf' Hpre).
reflexivity.
Qed.
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment