Commit e05af4c4 authored by Robbert Krebbers's avatar Robbert Krebbers

Many changes.

- Better representation of symbolic integers
- Better representation of symbolic locations
- Support while in the vcg
- Support alloc in the vcg
- A better reification mechanism
- Better proofmode support for mapsto with lists
- Normalize fractions
- Restructure lots of proofs
- ...
parent 02d768f0
......@@ -7,6 +7,7 @@ theories/lib/spin_lock.v
theories/lib/flock.v
theories/lib/locking_heap.v
theories/lib/U.v
theories/lib/Q.v
theories/c_translation/monad.v
theories/c_translation/proofmode.v
theories/c_translation/translation.v
......@@ -14,6 +15,7 @@ theories/vcgen/dcexpr.v
theories/vcgen/denv.v
theories/vcgen/vcgen.v
theories/vcgen/proofmode.v
theories/vcgen/reification.v
theories/tests/basics.v
theories/tests/invoke.v
theories/tests/unknowns.v
......
......@@ -7,5 +7,5 @@ build: [make "-j%{jobs}%"]
install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris-c-monad"]
depends: [
"coq-iris" { (= "dev.2018-11-08.2.9eee9408") | (= "dev") }
"coq-iris" { (= "dev.2018-11-09.0.87ef9033") | (= "dev") }
]
......@@ -11,6 +11,7 @@ Definition a_alloc : val := λ: "x1" "x2",
"vv" ←ᶜ "x1" ||| "x2" ;;
let: "n" := Fst "vv" in
let: "v" := Snd "vv" in
assert: (#0 < "n");;
a_atomic_env (λ: <>, SOME (ref (SOME (lreplicate "n" "v")), #0)).
Notation "'allocᶜ' ( e1 , e2 )" := (a_alloc e1%E e2%E) (at level 80) : expr_scope.
......@@ -117,7 +118,7 @@ Notation "'whileᶜ' ( e1 ) { e2 }" := (a_while (λ: <>, e1)%E (λ: <>, e2)%E)
format "'whileᶜ' ( e1 ) { e2 }") : expr_scope.
(* A version of while with value lambdas, this is an artifact because of the way
heap_lang works in Coq *)
Notation "'whileVᶜ' ( e1 ) { e2 }" := (a_while (λ: <>, e1)%V (λ: <>, e2)%V)
Notation "'whileVᶜ' ( e1 ) { e2 }" := (a_while (LamV <> e1)%V (LamV <> e2)%V)
(at level 200, e1, e2 at level 200,
format "'whileVᶜ' ( e1 ) { e2 }") : expr_scope.
......@@ -188,7 +189,7 @@ Definition cbin_op_eval (op : cbin_op) (v1 v2 : val) : option val :=
| PtrPlusOp =>
cl cloc_of_val v1;
o int_of_val v2;
Some (cloc_to_val (cloc_plus cl o))
Some (cloc_to_val (cl + o))
| PtrLtOp =>
cl1 cloc_of_val v1;
cl2 cloc_of_val v2;
......@@ -211,10 +212,9 @@ 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 : Z,
v1 = #n
(0 n)%Z
l, l C replicate (Z.to_nat n) v2 - Φ (cloc_to_val l)) -
( v1 v2, Ψ1 v1 - Ψ2 v2 - n : nat,
v1 = #n n 0%nat
l, l C replicate n v2 - Φ (cloc_to_val l)) -
AWP alloc(e1, e2) @ R {{ Φ }}.
Proof.
iIntros "H1 H2 HΦ".
......@@ -224,17 +224,19 @@ Section proofs.
iApply awp_bind. iApply (awp_par with "H1 H2").
iIntros "!>" (w1 w2) "H1 H2 !>". awp_pures.
iDestruct ("HΦ" with "H1 H2") as (n -> ?) "HΦ".
awp_apply wp_assert. wp_op. rewrite bool_decide_true; last lia.
iSplit; first done. iNext. awp_pures.
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Φ" $! (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.
iSplitL "Hlocks Hσ".
- 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.
- by iApply ("HΦ" $! (CLoc l 0)).
Qed.
Lemma a_store_spec R Φ Ψ1 Ψ2 e1 e2 :
......@@ -255,7 +257,7 @@ Section proofs.
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_loc cl), #(cloc_offset cl))%V X) as HclX.
assert ((#(cloc_base cl), #(cloc_offset cl))%V X) as HclX.
{ intros Hcl. destruct (HX _ Hcl) as (cl'&[=]%cloc_to_of_val&?). naive_solver. }
iMod (full_locking_heap_store_upd with "Hσ Hl") as (ll vs Hl Hi) "[Hl Hclose]".
wp_pures. rewrite cloc_to_val_eq. wp_pures.
......@@ -267,7 +269,7 @@ Section proofs.
iApply wp_fupd. wp_store.
iMod ("Hclose" $! _ LLvl with "[//] Hl") as "[Hσ Hl]".
iIntros "!> !> {$HR}". iSplitL "Hlocks Hσ"; last by iApply "HΦ".
iExists ({[(#(cloc_loc cl), #(cloc_offset cl))%V]} X), _.
iExists ({[(#(cloc_base cl), #(cloc_offset cl))%V]} X), _.
iFrame "Hσ Hlocks". iPureIntro. rewrite locked_locs_lock. set_solver.
Qed.
......@@ -284,7 +286,7 @@ Section proofs.
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.
assert ((#(cloc_loc cl), #(cloc_offset cl))%V X) as HclX.
assert ((#(cloc_base cl), #(cloc_offset cl))%V X) as HclX.
{ intros Hcl. destruct (HX _ Hcl) as (?&[=]%cloc_to_of_val&?); naive_solver. }
iMod (full_locking_heap_load_upd with "Hσ Hl") as (ll vs Hl Hi) "[Hl Hclose]".
wp_pures. rewrite cloc_to_val_eq. wp_pures.
......@@ -334,7 +336,7 @@ Section proofs.
Qed.
Lemma a_seq_bind_spec R Φ x e1 e2 :
AWP e1 @ R {{ v, U (AWP subst x v e2 @ R {{ Φ }}) }} -
AWP e1 @ R {{ v, U (AWP subst' x v e2 @ R {{ Φ }}) }} -
AWP x ←ᶜ e1 ; e2 @ R {{ Φ }}.
Proof.
iIntros "H". awp_pures. iApply a_seq_bind_spec'.
......@@ -355,7 +357,7 @@ Section proofs.
Lemma a_while_spec R Φ c e :
AWP whileV (c) { e } @ R {{ Φ }} -
AWP while (c) { e } @ R {{ Φ }}.
Proof. iIntros "H". awp_pures. by rewrite -!lock. Qed.
Proof. iIntros "H". by awp_pures. Qed.
Lemma a_whileV_spec R Φ c e :
(* The later is crucial for Löb induction *)
......@@ -368,9 +370,8 @@ Section proofs.
awp_apply (a_wp_awp with "H"). iIntros (v) "H". awp_lam. awp_pures.
iApply a_seq_bind_spec'. iApply (awp_wand with "H").
iIntros (v') "[[-> H] | [-> H]] !>".
- awp_pures. iApply a_seq_bind_spec'. awp_lam.
iApply (awp_wand with "H").
iIntros (w) "H !>". by awp_lam.
- awp_pures. iApply a_seq_bind_spec'.
iApply (awp_wand with "H"); iIntros (w) "H !>". by awp_lam.
- awp_pures. iApply awp_ret. by iApply wp_value.
Qed.
......@@ -388,7 +389,7 @@ Section proofs.
iApply (awp_wand with "H"); iIntros (_) "HI !>". by iApply "IH".
Qed.
Lemma a_invoke_spec R Ψ Φ (f : val) ea :
Lemma a_call_spec R Ψ Φ (f : val) ea :
AWP ea @ R {{ Ψ }} -
( a, Ψ a - U (R - R', R' (AWP f a @ R' {{ v, R' - R Φ v }}))) -
AWP call (f, ea) @ R {{ Φ }}.
......@@ -419,7 +420,7 @@ Section proofs.
AWP e1 @ R {{ v1, v2, Ψ2 v2 - cl (n : Z),
v1 = cloc_to_val cl
v2 = #n
Φ (cloc_to_val (cloc_plus cl n)) }} -
Φ (cloc_to_val (cl + n)) }} -
AWP a_ptr_plus e1 e2 @ R {{ Φ }}.
Proof.
iIntros "He2 HΦ".
......@@ -488,11 +489,11 @@ Section proofs.
Lemma a_pre_bin_op_spec R Φ Ψ1 Ψ2 e1 e2 op :
AWP e1 @ R {{ Ψ1 }} - AWP e2 @ R {{ Ψ2 }} -
( v1 v2, Ψ1 v1 - Ψ2 v2 - R -
( v1 v2, Ψ1 v1 - Ψ2 v2 -
cl v w, v1 = cloc_to_val cl
cl C v
cbin_op_eval op v v2 = Some w
(cl C[LLvl] w - R Φ v)) -
(cl C[LLvl] w - Φ v)) -
AWP a_pre_bin_op op e1 e2 @ R {{ Φ }}.
Proof.
iIntros "He1 He2 HΦ".
......@@ -501,8 +502,8 @@ Section proofs.
iApply awp_bind. iApply (awp_par with "Ha1 Ha2"). iNext.
iIntros (v1 v2) "Hv1 Hv2 !>". awp_pures.
iApply awp_atomic.
iIntros "!> R". iDestruct ("HΦ" with "Hv1 Hv2 R") as (cl v w ->) "(Hl & % & HΦ)".
simplify_eq/=. iExists True%I. rewrite left_id. awp_pures.
iIntros "!> HR". iDestruct ("HΦ" with "Hv1 Hv2") as (cl v w ->) "(Hl & % & HΦ)".
simplify_eq/=. iExists True%I. iSplit; first done. awp_pures.
iApply awp_bind. iApply a_load_spec. iApply awp_ret. iApply wp_value.
iExists cl, v; iFrame. iSplit; first done.
iIntros "Hl". awp_pures. iApply awp_bind.
......@@ -515,7 +516,7 @@ Section proofs.
- iIntros (? ? -> ->).
iExists _, _; iFrame. iSplit; first done.
iIntros "?". awp_seq. iApply awp_ret; iApply wp_value.
iIntros "_". by iApply "HΦ".
iIntros "_". iFrame "HR". by iApply "HΦ".
Qed.
End proofs.
......
From iris.algebra Require Export frac.
From Coq Require Export QArith Qcanon.
Lemma Q_plus_nonneg p q : (0 < p)%Q (0 < q)%Q (0 < p + q)%Q.
Proof.
intros. apply Qlt_trans with p=> //. by rewrite -{1}(Qplus_0_r p) Qplus_lt_r.
Qed.
Lemma Q_div_nonneg p n : (0 < p)%Q (0 < p / Zpos n)%Q.
Proof. intros. by apply Qlt_shift_div_l. Qed.
Instance Q_eq_dec : EqDecision Q.
Proof. solve_decision. Defined.
Instance Q_Qeq_dec : RelDecision Qeq.
Proof. intros pq; apply Qeq_dec. Defined.
Instance Q_lt_dec : RelDecision Qlt.
Proof. refine (λ p q, cast_if (Qlt_le_dec p q)); auto using Qle_not_lt. Defined.
Fixpoint Pos_to_pred_nat (p : positive) : nat :=
match p with
| xH => 0
| xO p => S (2 * Pos_to_pred_nat p)
| xI p => S (S (2 * Pos_to_pred_nat p))
end.
Definition Q_to_Qp (q : Q) : Qp :=
match Qred q with
| Qmake (Zpos n) 1 => Nat.iter (Pos_to_pred_nat n) (λ n, 1 + n) 1
| Qmake (Zpos n) d => Nat.iter (Pos_to_pred_nat n) (λ n, 1 + n) 1 / d
| _ => 1 (* dummy *)
end%Qp.
Arguments Q_to_Qp !_ /.
Arguments Pos.mul !_ !_ /.
Local Arguments Q_to_Qp : simpl never.
Lemma Q_to_Qp_le_0 q : ¬(0 < q)%Q Q_to_Qp q = 1%Qp.
Proof.
destruct q as [[|n|n] d]=> //=.
rewrite /Q_to_Qp /Qred /=. by destruct (Pos.ggcd _ _) as [? [??]].
Qed.
Lemma Q_to_Qp_1 : Q_to_Qp 1 = 1%Qp.
Proof. done. Qed.
Lemma Pos_to_pred_Q_spec p :
Nat.iter (Pos_to_pred_nat p) (λ n, 1 + n)%Qp 1%Qp == Qmake (Z.pos p) 1.
Proof.
cut ( q,
Nat.iter (Pos_to_pred_nat p) (λ n, 1 + n)%Qp q == Qmake (Z.pos p) 1 + q - 1).
{ intros ->. rewrite /Qeq /=; lia. }
induction p as [p IH|p IH|]=> q' //=.
- rewrite !Qred_correct !Nat_iter_add !IH /=. rewrite /Qeq /=; lia.
- rewrite !Qred_correct !Nat_iter_add !IH /=. rewrite /Qeq /=; lia.
- rewrite /Qeq /=; lia.
Qed.
(* this (Qp_car (Q_to_Qp q)) : Q) == q *)
Lemma Q_of_to_Qp (q : Q) : (0 < q)%Q (Q_to_Qp q : Q) == q.
Proof.
rewrite -{1 3}(Qred_correct q) /Q_to_Qp.
destruct (Qred q) as [[|n|n] d]=> ? //=.
destruct d as [d|d|]=> //=.
- by rewrite Pos_to_pred_Q_spec !Qred_correct /Qeq /= Z.mul_1_r.
- by rewrite Pos_to_pred_Q_spec !Qred_correct /Qeq /= Z.mul_1_r.
- by rewrite Pos_to_pred_Q_spec.
Qed.
(* Q_to_Qp (this (Qp_car q) : Q) = q *)
Lemma Q_to_of_Qp (q : Qp) : Q_to_Qp (q : Q) = q.
Proof. apply Qp_eq, Qc_is_canon. destruct q as [n d]. by rewrite Q_of_to_Qp. Qed.
Instance Q_to_Qp_proper : Proper (Qeq ==> (=)) Q_to_Qp.
Proof. rewrite /Q_to_Qp. by intros p p' ->%Qred_complete. Qed.
Lemma Q_to_Qp_plus p q :
(0 < p)%Q (0 < q)%Q Q_to_Qp (p + q) = (Q_to_Qp p + Q_to_Qp q)%Qp.
Proof.
intros. assert (0 < p + q)%Q by eauto using Q_plus_nonneg.
apply Qp_eq, Qc_is_canon. by rewrite /= Qred_correct !Q_of_to_Qp.
Qed.
Lemma Q_to_Qp_div q p :
(0 < q)%Q Q_to_Qp (q / Zpos p) = (Q_to_Qp q / p)%Qp.
Proof.
intros. assert (0 < q / Z.pos p)%Q by eauto using Q_div_nonneg.
apply Qp_eq, Qc_is_canon. by rewrite /= !Qred_correct !Q_of_to_Qp.
Qed.
......@@ -64,9 +64,9 @@ Section U.
Proof. rewrite /IntoUnlock. reflexivity. Qed.
Global Instance into_unlock_id P : IntoUnlock P P | 10.
Proof. apply U_intro. Qed.
Global Instance into_unlock_unlock l q v :
IntoUnlock (l C[LLvl]{q} v)%I (l C{q} v)%I | 0.
Proof. apply U_unlock. Qed.
Global Instance into_unlock_unlock l q v x :
IntoUnlock (l C[x]{q} v)%I (l C{q} v)%I | 0.
Proof. destruct x. apply U_unlock. apply U_intro. Qed.
Lemma modality_U_mixin :
modality_mixin U MIEnvId (MIEnvTransform IntoUnlock).
......
This diff is collapsed.
......@@ -5,50 +5,35 @@ Section test.
Context `{amonadG Σ}.
(** dereferencing *)
Lemma test1 (l : cloc) (v: val) :
l C v - AWP ∗ᶜ ♯ₗl {{ w, w = v l C v }}.
Proof.
iIntros "Hl1". vcg_solver. auto.
Qed.
Lemma test1 cl v :
cl C v - AWP ∗ᶜ ♯ₗcl {{ w, w = v cl C v }}.
Proof. iIntros "**". vcg. auto. Qed.
(** double dereferencing *)
Lemma test2 (l1 l2 : cloc) (v: val) :
l1 C cloc_to_val l2 - l2 C v -
AWP ∗ᶜ ∗ᶜ ♯ₗl1 {{ v, v = #1 l1 C cloc_to_val l2 - l2 C v }}.
Proof.
iIntros "Hl1 Hl2". vcg_solver. auto.
Qed.
Lemma test2 cl1 cl2 v :
cl1 C cloc_to_val cl2 - cl2 C v -
AWP ∗ᶜ ∗ᶜ ♯ₗcl1 {{ v, v = #1 cl1 C cloc_to_val cl2 - cl2 C v }}.
Proof. iIntros "**". vcg. auto. Qed.
(** sequence points *)
Lemma test3 (l : cloc) (v: val) :
l C v - AWP ∗ᶜ ♯ₗl ; ∗ᶜ ♯ₗl {{ w, w = v l C v }}.
Proof.
iIntros "Hl1". vcg_solver. auto.
Qed.
Lemma test3 cl v :
cl C v - AWP ∗ᶜ ♯ₗcl ; ∗ᶜ ♯ₗcl {{ w, w = v cl C v }}.
Proof. iIntros "**". vcg. auto. Qed.
(** assignments *)
Lemma test4 (l : cloc) (v1 v2: val) :
l C v1 - AWP ♯ₗl = a_ret v2 {{ v, v = v2 l C[LLvl] v2 }}.
Proof.
iIntros "Hl1". vcg_solver. auto.
Qed.
Proof. iIntros "**". vcg. auto. Qed.
Lemma store_load s l R :
s C #0 - l C #1 -
AWP ♯ₗs = ∗ᶜ ♯ₗl @ R {{ _, s C[LLvl] #1 l C #1 }}.
Proof.
iIntros "Hs Hl".
vcg_solver. eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. auto with iFrame. Qed.
Lemma store_load_load s1 s2 l R :
s1 C #0 - l C #1 - s2 C #0 -
AWP ♯ₗs1 = ∗ᶜ ♯ₗl ; ∗ᶜ ♯ₗs1 + 42 @ R {{ _, s1 C #1 l C #1 }}.
Proof.
iIntros "Hs1 Hl Hs2". vcg_solver.
rewrite Qp_half_half. eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. auto with iFrame. Qed.
(** double dereferencing & modification *)
Lemma test5 (l1 l2 r1 r2 : cloc) (v1 v2: val) :
......@@ -57,128 +42,93 @@ Section test.
AWP ♯ₗl1 = ♯ₗr1 ; ∗ᶜ ∗ᶜ ♯ₗl1
{{ w, w = v2
l1 C cloc_to_val r2 l2 C v1 r1 C cloc_to_val r2 - r2 C v2 }}.
Proof.
iIntros "**". vcg_solver. eauto 40.
Qed.
Proof. iIntros "**". vcg. auto with iFrame. Qed.
(** par *)
Lemma test_par_1 (l1 l2 : cloc) (v1 v2: val) :
l1 C v1 - l2 C v2 -
AWP ∗ᶜ ♯ₗl1 ||| ∗ᶜ ♯ₗl2
{{ w, w = (v1, v2)%V l1 C v1 l2 C v2 }}.
Proof.
iIntros "**". vcg_solver. rewrite Qp_half_half. eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. auto with iFrame. Qed.
Lemma test_par_2 (l1 l2 : cloc) (v1 v2: val) :
l1 C v1 - l2 C v2 -
AWP (♯ₗl1 = a_ret v2) ||| (♯ₗl2 = a_ret v1)
{{ w, w = (v2, v1)%V l1 C[LLvl] v2 l2 C[LLvl] v1 }}.
Proof.
iIntros "**". vcg_solver. eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. auto with iFrame. Qed.
(** pre bin op *)
Lemma test6 (l : cloc) (z0 : Z) R:
l C #z0 -
AWP ♯ₗl += 1 @ R {{ v, v = #z0 l C[LLvl] #(z0+1) }}.
Proof.
iIntros "Hl". vcg_solver. eauto.
Qed.
AWP ♯ₗl += 1 @ R {{ v, v = #z0 l C[LLvl] #(1 + z0) }}.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
Lemma test7 (l k : cloc) (z0 z1 : Z) R:
l C #z0 -
k C #z1 -
AWP (♯ₗl += 1) + (∗ᶜ♯ₗk) @
R {{ v, v = #(z0+z1) l C[LLvl] #(z0+1) k C #z1 }}.
Proof.
iIntros "Hl Hk". vcg_solver. eauto with iFrame.
Qed.
AWP (♯ₗl += 1) + (∗ᶜ♯ₗk) @ R
{{ v, v = #(z0+z1) l C[LLvl] #(1 + z0) k C #z1 }}.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
(** more sequences *)
Lemma test_seq s l :
s C[ULvl] #0 - l C[ULvl] #1 -
AWP (♯ₗl = 2 ; 1 + (♯ₗ l = 1)) + (♯ₗ s = 4)
{{ v, v = #6 s C[LLvl] #4 l C[LLvl] #1 }}.
Proof.
iIntros "Hs Hl".
vcg_solver. eauto with iFrame.
Qed.
{{ v, v = #6 s C[LLvl] #4 l C[LLvl] #1 }}.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
Lemma test_seq2 s l :
s C[ULvl] #0 - l C[ULvl] #1 -
AWP (♯ₗl = 2 ; ∗ᶜ ♯ₗl) + (♯ₗs = 4) {{ v, v = #6 s C[LLvl] #4 l C #2 }}.
Proof.
iIntros "Hs Hl".
vcg_solver.
rewrite Qp_half_half. eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
Lemma test_seq3 l :
l C #0 -
AWP ♯ₗl = 2 ; 1 + (♯ₗl = 1) {{ _, l C[LLvl] #1 }}.
Proof.
iIntros "Hl". vcg_solver. eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
Lemma test_seq4 l k :
l C #0 -
k C #0 -
AWP (♯ₗl = 2 ; 1 + (♯ₗl = 1)) + (♯ₗk = 2 ; 1 + (♯ₗk = 1))
{{ v, v = #4 l C[LLvl] #1 k C[LLvl] #1 }}.
Proof.
iIntros "Hl Hk".
vcg_solver. by eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
Definition stupid (l : cloc) : expr :=
a_store (♯ₗ l) ( 1); a_ret #0.
Lemma test_seq_fail l :
l C[ULvl] #0 -
AWP ((stupid l) + (stupid l)) + (a_ret #0) @
True {{ v, l C #1 }}.
Proof.
iIntros "Hl". vcg_solver. Fail by eauto with iFrame.
Abort.
AWP ((stupid l) + (stupid l)) + (a_ret #0) {{ v, l C #1 }}.
Proof. iIntros "**". vcg. Fail by eauto with iFrame. Abort.
Lemma test_seq5 l k :
l C #0 -
k C #0 -
AWP 0 + (♯ₗl = 1 ; ♯ₗk = 2 ; 0) {{ v, v = #0 l C #1 k C #2 }}.
Proof.
iIntros "Hl Hk". vcg_solver.
repeat iModIntro. by eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
Lemma test_seq6 l k :
l C #0 -
k C #0 -
AWP 1 + (♯ₗl = 1 ; (♯ₗk = 2) + ∗ᶜ ♯ₗl ; ∗ᶜ ♯ₗk + (♯ₗl = 2))
{{ v, v = #5 l C[LLvl] #2 k C #2 }}.
Proof.
iIntros "Hl Hk". vcg_solver.
repeat iModIntro. rewrite ?Qp_half_half.
eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
Lemma test_seq7 l :
l C #0 -
AWP 1 + (♯ₗl = 1 ; ∗ᶜ ♯ₗl + ∗ᶜ ♯ₗl ; ♯ₗl = 2) {{ v, v = #3 l C[LLvl] #2 }}.
Proof.
iIntros "Hl". vcg_solver.
repeat iModIntro. rewrite ?Qp_half_half.
eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
(** while *)
Lemma test_while l R :
l C #1 -
AWP while (∗ᶜ ♯ₗl < 2) { ♯ₗl = 1 } @ R {{ _, True }}.
Proof.
iIntros "Hl". iApply a_while_spec.
iLöb as "IH". iApply a_whileV_spec. iNext.
vcg_solver. rewrite Qp_half_half. iIntros "Hl".
iIntros "**". vcg. iIntros "**". iLöb as "IH".
iApply a_whileV_spec; iNext.
vcg. iIntros "Hl".
iLeft. iSplitR; eauto. iModIntro.
vcg_solver. iIntros "Hl". iModIntro. by iApply "IH".
vcg. iIntros "Hl". iModIntro. by iApply "IH".
Qed.
End test.
......@@ -3,14 +3,10 @@ From iris_c.vcgen Require Import proofmode.
Section test.
Context `{amonadG Σ}.
Lemma ptr_plus_test1 (p q : cloc) (n : nat) v1 R Φ :
Lemma ptr_plus_test1 p q n v1 R Φ :
Φ (cloc_to_val (cloc_plus p n)) -
p C v1 -
q C cloc_to_val p -
AWP (∗ᶜ♯ₗq +∗ᶜ n) @ R {{ v, Φ v p C v1 q C cloc_to_val p }}.
Proof.
iIntros "HΦ Hp Hq". vcg_solver.
rewrite Qp_half_half.
eauto with iFrame.
Qed.
Proof. iIntros "**". vcg. eauto with iFrame. Qed.
End test.
From iris_c.vcgen Require Import proofmode.
Local Open Scope Z_scope.
Section memcpy.
Context `{amonadG Σ}.
Definition memcpy : val := λ: "arg",
"p" ←ᶜ a_alloc 1 (a_ret (Fst "arg"));
"q" ←ᶜ a_alloc 1 (a_ret (Fst (Snd "arg")));
"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);
skip (* sequence point, should be implicit in the def. of while *)
}.
Definition memcpy : val := λ: "arg",
"p" ←ᶜ a_alloc 1 (a_ret (Fst "arg"));;
"q" ←ᶜ a_alloc 1 (a_ret (Fst (Snd "arg")));;
"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)
}.
Lemma memcpy_body_spec (* (i: nat) *) (pp qq p q : cloc) (n : nat) (ls1 ls2 : list val) R :
length ls1 = n
length ls2 = n
(* ⌜take i ls1 = take i ls2⌝ -∗ *)
p C ls1 -
q C