Commit 98432a2e authored by Dan Frumin's avatar Dan Frumin

Uniform treatment of ML binops and C-level pointer operations

parent 7455d45f
......@@ -58,7 +58,7 @@ Section derived.
Lemma awp_bin_op_load_load op (l r : cloc) (v1 v2: val) R Φ :
l C v1 - r C v2 -
(l C v1 - r C v2 - w : val, bin_op_eval op v1 v2 = Some w Φ w) -
(l C v1 - r C v2 - w : val, cbin_op_eval op v1 v2 = Some w Φ w) -
awp (a_bin_op op (a_load (a_ret (cloc_to_val l))) (a_load (a_ret (cloc_to_val r)))) R Φ.
Proof.
iIntros "Hl Hr HΦ".
......@@ -75,7 +75,7 @@ Section derived.
l C v -
AWP e1 @ R {{ Ψ1 }} - AWP e2 @ R {{ Ψ2 }} -
( v1 v2, Ψ1 v1 - Ψ2 v2 - v1 = cloc_to_val l
w, bin_op_eval op v v2 = Some w
w, cbin_op_eval op v v2 = Some w
(l C[LLvl] w - Φ v)) -
AWP a_pre_bin_op op e1 e2 @ R {{ Φ }}.
Proof.
......
This diff is collapsed.
......@@ -92,7 +92,7 @@ Section definitions.
(** Pointer arithmetic *)
Definition cloc_lt (p q : cloc) : bool :=
bool_decide (p.1 = q.1 p.2 < q.2).
bool_decide (p.1 = q.1) && bool_decide (p.2 < q.2)%nat.
Definition cloc_add (cl : cloc) (i : nat) : cloc := (cl.1, cl.2 + i).
Definition cloc_to_val (cl : cloc) : val := (#cl.1, #cl.2).
......
......@@ -138,6 +138,14 @@ Definition dbin_op_eval
| _, _ => dNone
end.
Definition dcbin_op_eval (E: known_locs) (op : cbin_op) (dv1 dv2 : dval) : doption dval :=
match op with
| CBinOp op' => dbin_op_eval E op' dv1 dv2
| PtrPlusOp | PtrLtOp =>
dUnknown (dValUnknown <$> cbin_op_eval op (dval_interp E dv1) (dval_interp E dv2))
end.
Lemma dbin_op_eval_correct E op dv1 dv2 w :
doption_interp (dbin_op_eval E op dv1 dv2) = Some w
bin_op_eval op (dval_interp E dv1) (dval_interp E dv2) =
......@@ -170,6 +178,17 @@ Proof.
try by inversion 1.
Qed.
Lemma dcbin_op_eval_correct E op dv1 dv2 w :
doption_interp (dcbin_op_eval E op dv1 dv2) = Some w
cbin_op_eval op (dval_interp E dv1) (dval_interp E dv2) =
Some (dval_interp E w).
Proof.
destruct op as [op'| |].
- apply dbin_op_eval_correct.
- cbn-[cbin_op_eval]. destruct (cbin_op_eval PtrPlusOp (dval_interp E dv1) (dval_interp E dv2)); naive_solver.
- cbn-[cbin_op_eval]. destruct (cbin_op_eval PtrLtOp (dval_interp E dv1) (dval_interp E dv2)); naive_solver.
Qed.
Definition dun_op_eval
(E : known_locs) (op : un_op) (dv : dval) : doption dval :=
match dv with
......@@ -206,8 +225,8 @@ Inductive dcexpr : Type :=
| dCAlloc : dcexpr dcexpr
| dCLoad : dcexpr dcexpr
| dCStore : dcexpr dcexpr dcexpr
| dCBinOp : bin_op dcexpr dcexpr dcexpr
| dCPreBinOp : bin_op dcexpr dcexpr dcexpr
| dCBinOp : cbin_op dcexpr dcexpr dcexpr
| dCPreBinOp : cbin_op dcexpr dcexpr dcexpr
| dCUnOp : un_op dcexpr dcexpr
| dCSeq : dcexpr dcexpr dcexpr
| dCPar : dcexpr dcexpr dcexpr
......@@ -286,6 +305,11 @@ Lemma dbin_op_eval_dSome_wf E dv1 dv2 op dw:
dbin_op_eval E op dv1 dv2 = dSome dw dval_wf E dw.
Proof. destruct op, dv1,dv2; simpl; repeat case_match; naive_solver. Qed.
Lemma dcbin_op_eval_dSome_wf E dv1 dv2 op dw:
dval_wf E dv1 dval_wf E dv2
dcbin_op_eval E op dv1 dv2 = dSome dw dval_wf E dw.
Proof. destruct op; first eauto using dbin_op_eval_dSome_wf; naive_solver. Qed.
(** / Well-foundness of dcexpr w.r.t. known_locs *)
Lemma dval_interp_mono (E E': known_locs) (dv: dval) :
......
......@@ -18,7 +18,16 @@ Section memcpy.
let: "n" := Snd (Snd "arg") in
"pend" ←ᶜ ∗ᶜ(a_ret "p") +∗ᶜ (a_ret "n");;
while (∗ᶜ(a_ret "p") <∗ᶜ (a_ret "pend"))
{ ((a_ret "p")+=ᶜ♯1) = ∗ᶜ((a_ret "q")+=ᶜ♯1) }.
{ ((a_ret "p")+=ᶜ♯1) = ∗ᶜ((a_ret "q")+=ᶜ♯1) }.
(* TODO: move somewhere *)
Lemma cloc_lt_Z_eq l1 (o1 : nat) l2 (o2 : nat) :
cloc_lt_Z l1 o1 l2 o2 = Some (cloc_lt (l1,o1) (l2,o2)).
Proof. Admitted.
Lemma cloc_add_Z_eq l1 (o1 o2 : nat) :
cloc_add_Z l1 o1 o2 = Some (cloc_add (l1,o1) o2).
Proof. Admitted.
Lemma memcpy_body_spec (i: nat) (pp p q : cloc) (n : nat) (ls1 ls2 : list val) R :
length ls1 = n
......@@ -28,28 +37,25 @@ Section memcpy.
q C ls2 -
pp C (#p.1, #(p.2+i)%nat) -
AWP while (∗ᶜ (a_ret (#pp.1, #pp.2)) <∗ᶜ a_ret (#p.1, #(p.2 + n)%nat))
{ (a_ret (#pp.1, #pp.2) += 1) = ∗ᶜ (a_ret (#q.1, #q.2) += 1) }
{ (a_ret (#pp.1, #pp.2) += 1) = ∗ᶜ (a_ret (#q.1, #q.2) += 1) }
@ R {{ _, p C ls2 q C ls2 }}.
Proof.
iIntros (? ?) "Htake Hp Hq Hpp".
iLöb as "IH" forall (i). iDestruct "Htake" as %Htake.
iApply a_while_spec'.
iNext.
iApply (a_ptr_lt_spec _ _ (λ v, v = (#p.1, #(p.2+i)%nat)%V pp C (#p.1, #(p.2+i)%nat))%I with "[Hpp]").
{ vcg_solver. eauto. }
vcg_solver. iNext. iIntros (?) "[% Hpp]"; simplify_eq/=.
iExists (p.1,p.2+i)%nat,(p.1,p.2+length ls1)%nat; repeat iSplit; eauto.
iNext. vcg_solver. simpl.
destruct (decide (i < length ls1)%nat).
- iLeft. iSplit.
{ iPureIntro. compute[cloc_lt]. f_equal. simpl.
rewrite bool_decide_true; auto. split; auto. omega. }
- iExists (dValUnknown #true). iSplit.
{ iPureIntro. rewrite cloc_lt_Z_eq /= /cloc_lt. do 3 f_equal. simpl.
rewrite !bool_decide_true; auto. omega. }
vcg_continue. iLeft; iSplit; first done.
(* vcg_solver DF: doesnt do anything *)
admit.
- iRight. iSplit.
{ iPureIntro. compute[cloc_lt]. f_equal. simpl.
rewrite bool_decide_false; auto. intros [? ?]. omega. }
iApply a_seq_spec. iModIntro.
- iExists (dValUnknown #false). iSplit.
{ iPureIntro. rewrite cloc_lt_Z_eq /= /cloc_lt. do 3 f_equal. simpl.
rewrite bool_decide_true // bool_decide_false //. omega. }
vcg_continue. iRight; iSplit; first done.
iApply a_seq_spec. iModIntro. simplify_eq/=.
assert (ls1 = ls2) as ->.
{ generalize dependent i. generalize dependent ls2. induction ls1; simpl; eauto.
- intros ls2 ->%nil_length_inv. done.
......@@ -77,11 +83,17 @@ Section memcpy.
iNext. iIntros (? ->). iExists 1%nat. iSplit; eauto.
iIntros (pp) "[Hpp _]". rewrite {3}/cloc_add. etaprod pp.
repeat awp_pure _. iApply awp_bind.
iApply (a_ptr_add_spec _ _ (λ v, v = #n))%I; first by (iApply awp_ret; wp_value_head).
vcg_solver. iIntros "Hpp".
iNext. iIntros (? ->). iExists p,n; repeat iSplit; eauto.
awp_let. iApply (memcpy_body_spec 0 with "[] Hp Hq [Hpp]"); eauto.
by rewrite Nat.add_0_r.
(* DF: TODO!! if we run vcg_solver here then we loose pp ↦ -
some problem with vcgen for pre_op?
*)
iApply (a_bin_op_spec _ _ (λ v, v = cloc_to_val p pp C (#p.1, #p.2)) (λ v, v = #n) with "[Hpp]")%I.
- vcg_solver. eauto.
- by vcg_solver.
- iNext. iIntros (? ?) "[% Hpp] %". simplify_eq/=.
iExists (cloc_to_val (p.1,p.2+length ls1))%nat; repeat iSplit; eauto.
{ rewrite cloc_add_Z_eq. done. }
awp_let. iApply (memcpy_body_spec 0 with "[] Hp Hq [Hpp]"); eauto.
by rewrite Nat.add_0_r.
Qed.
End memcpy.
......@@ -48,8 +48,8 @@ Section tests_vcg.
Lemma test_seq_fail l :
l C[ULvl] #0 -
awp (a_bin_op PlusOp (a_bin_op PlusOp (stupid l) (stupid l)) (a_ret #0))
True (λ v, l C #1).
AWP ((stupid l) + (stupid l)) + (a_ret #0) @
True {{ v, l C #1 }}.
Proof.
iIntros "Hl". vcg_solver. Fail by eauto with iFrame.
Abort.
......
This diff is collapsed.
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