Skip to content

C
c
Commit bfa32cfe authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files
Options

Rename stuff to be consistent with the paper.

parent 81137d7c
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 659 additions and 659 deletions
theories/c_translation/monad.v
View file @ bfa32cfe
This diff is collapsed.
theories/c_translation/proofmode.v
View file @ bfa32cfe
......@@ -2,41 +2,41 @@ From iris.heap_lang Require Export proofmode notation.
From iris_c.c_translation Require Export monad.
From iris.proofmode Require Import coq_tactics.
Lemma tac_awp_bind `{amonadG Σ} K Δ R Φ e f :
Lemma tac_cwp_bind `{cmonadG Σ} K Δ R Φ e f :
f = (λ e, fill K e) → (* as an eta expanded hypothesis so that we can `simpl` it *)
envs_entails Δ (WP e {{ v, awp (f (of_val v)) R Φ }})%I →
envs_entails Δ (awp (fill K e) R Φ).
Proof. rewrite envs_entails_eq=> -> ->. by apply: wp_awp_bind. Qed.
envs_entails Δ (WP e {{ v, cwp (f (of_val v)) R Φ }})%I →
envs_entails Δ (cwp (fill K e) R Φ).
Proof. rewrite envs_entails_eq=> -> ->. by apply: wp_cwp_bind. Qed.
Ltac awp_bind_core K :=
Ltac cwp_bind_core K :=
lazymatch eval hnf in K with
| [] => idtac
| _ => eapply (tac_awp_bind K); [simpl; reflexivity|lazy beta]
| _ => eapply (tac_cwp_bind K); [simpl; reflexivity|lazy beta]
end.
Tactic Notation "awp_apply" open_constr(lem) :=
Tactic Notation "cwp_apply" open_constr(lem) :=
iPoseProofCore lem as false true (fun H =>
lazymatch goal with
| |- envs_entails _ (awp ?e ?R ?Q) =>
| |- envs_entails _ (cwp ?e ?R ?Q) =>
reshape_expr e ltac:(fun K e' =>
awp_bind_core K; iApplyHyp H; try iNext (*; try wp_expr_simpl*) ) ||
cwp_bind_core K; iApplyHyp H; try iNext (*; try wp_expr_simpl*) ) ||
lazymatch iTypeOf H with
| Some (_,?P) => fail "awp_apply: cannot apply" P
| Some (_,?P) => fail "cwp_apply: cannot apply" P
end
| _ => fail "awp_apply: not a 'awp'"
| _ => fail "cwp_apply: not a 'cwp'"
end).
Lemma tac_awp_pure `{amonadG Σ} Δ Δ' K e1 e2 e φ n R Φ :
Lemma tac_cwp_pure `{cmonadG Σ} Δ Δ' K e1 e2 e φ n R Φ :
e = fill K e1 →
PureExec φ n e1 e2 →
φ →
MaybeIntoLaterNEnvs n Δ Δ' →
envs_entails Δ' (awp (fill K e2) R Φ) →
envs_entails Δ (awp e R Φ).
envs_entails Δ' (cwp (fill K e2) R Φ) →
envs_entails Δ (cwp e R Φ).
Proof.
rewrite envs_entails_eq=> -> ??? HΔ'.
rewrite into_laterN_env_sound /=.
rewrite HΔ' -awp_pure //.
rewrite HΔ' -cwp_pure //.
Qed.
Tactic Notation "tac_bind_helper" :=
......@@ -52,48 +52,48 @@ Tactic Notation "tac_bind_helper" :=
replace e with (fill K' e') by (by rewrite ?fill_app))
end; reflexivity.
Tactic Notation "awp_pure" open_constr(efoc) :=
Tactic Notation "cwp_pure" open_constr(efoc) :=
iStartProof;
lazymatch goal with
| |- envs_entails _ (awp ?e ?R ?Q) =>
| |- envs_entails _ (cwp ?e ?R ?Q) =>
let e := eval simpl in e in
reshape_expr e ltac:(fun K e' =>
unify e' efoc;
eapply (tac_awp_pure _ _ _ _ _ (fill K e'));
eapply (tac_cwp_pure _ _ _ _ _ (fill K e'));
[tac_bind_helper (* e = fill K e' *)
|apply _ (* PureExec *)
|try fast_done (* The pure condition for PureExec *)
|apply _ (* IntoLaters *)
|simpl
])
|| fail "awp_pure: cannot find" efoc "in" e "or" efoc "is not a redex"
| _ => fail "awp_pure: not an 'awp'"
|| fail "cwp_pure: cannot find" efoc "in" e "or" efoc "is not a redex"
| _ => fail "cwp_pure: not an 'cwp'"
end.
(* See Iris for documentation on this tactic *)
Ltac awp_pures :=
Ltac cwp_pures :=
iStartProof;
repeat (awp_pure _; []). (* The `;[]` makes sure that no side-condition
repeat (cwp_pure _; []). (* The `;[]` makes sure that no side-condition
magically spawns. *)
Tactic Notation "awp_rec" :=
Tactic Notation "cwp_rec" :=
let H := fresh in
assert (H := AsRecV_recv_locked);
awp_pure (App _ _);
cwp_pure (App _ _);
clear H.
Tactic Notation "awp_if" := awp_pure (If _ _ _).
Tactic Notation "awp_if_true" := awp_pure (If (LitV (LitBool true)) _ _).
Tactic Notation "awp_if_false" := awp_pure (If (LitV (LitBool false)) _ _).
Tactic Notation "awp_unop" := awp_pure (UnOp _ _).
Tactic Notation "awp_binop" := awp_pure (BinOp _ _ _).
Tactic Notation "awp_op" := awp_unop || awp_binop.
Tactic Notation "awp_lam" := awp_rec.
Tactic Notation "awp_let" := awp_lam.
Tactic Notation "awp_seq" := awp_lam.
Tactic Notation "awp_proj" := awp_pure (Fst _) || awp_pure (Snd _).
Tactic Notation "awp_case" := awp_pure (Case _ _ _).
Tactic Notation "awp_match" := awp_case; awp_let.
Tactic Notation "awp_inj" := awp_pure (InjL _) || wp_pure (InjR _).
Tactic Notation "awp_pair" := awp_pure (Pair _ _).
Tactic Notation "awp_closure" := awp_pure (Rec _ _ _).
Tactic Notation "cwp_if" := cwp_pure (If _ _ _).
Tactic Notation "cwp_if_true" := cwp_pure (If (LitV (LitBool true)) _ _).
Tactic Notation "cwp_if_false" := cwp_pure (If (LitV (LitBool false)) _ _).
Tactic Notation "cwp_unop" := cwp_pure (UnOp _ _).
Tactic Notation "cwp_binop" := cwp_pure (BinOp _ _ _).
Tactic Notation "cwp_op" := cwp_unop || cwp_binop.
Tactic Notation "cwp_lam" := cwp_rec.
Tactic Notation "cwp_let" := cwp_lam.
Tactic Notation "cwp_seq" := cwp_lam.
Tactic Notation "cwp_proj" := cwp_pure (Fst _) || cwp_pure (Snd _).
Tactic Notation "cwp_case" := cwp_pure (Case _ _ _).
Tactic Notation "cwp_match" := cwp_case; cwp_let.
Tactic Notation "cwp_inj" := cwp_pure (InjL _) || wp_pure (InjR _).
Tactic Notation "cwp_pair" := cwp_pure (Pair _ _).
Tactic Notation "cwp_closure" := cwp_pure (Rec _ _ _).
theories/c_translation/translation.v
View file @ bfa32cfe
This diff is collapsed.
theories/tests/basics.v
View file @ bfa32cfe
......@@ -2,44 +2,44 @@
From iris_c.vcgen Require Import proofmode.
Section test.
Context `{amonadG Σ}.
Context `{cmonadG Σ}.
(** dereferencing *)
Lemma test1 cl v :
cl ↦C v -∗ AWP ∗ᶜ ♯ₗcl {{ w, ⌜w = v⌝ ∗ cl ↦C v }}.
cl ↦C v -∗ CWP ∗ᶜ ♯ₗcl {{ w, ⌜w = v⌝ ∗ cl ↦C v }}.
Proof. iIntros. vcg. auto. Qed.
(** double dereferencing *)
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 }}.
CWP ∗ᶜ ∗ᶜ ♯ₗcl1 {{ v, ⌜v = #1⌝ ∗ cl1 ↦C cloc_to_val cl2 -∗ cl2 ↦C v }}.
Proof. iIntros. vcg. auto. Qed.
(** sequence points *)
Lemma test3 cl v :
cl ↦C v -∗ AWP ∗ᶜ ♯ₗcl ;ᶜ ∗ᶜ ♯ₗcl {{ w, ⌜w = v⌝ ∗ cl ↦C v }}.
cl ↦C v -∗ CWP ∗ᶜ ♯ₗ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 }}.
l ↦C v1 -∗ CWP ♯ₗl =ᶜ c_ret v2 {{ v, ⌜v = v2⌝ ∗ l ↦C[LLvl] v2 }}.
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 }}.
CWP ♯ₗs =ᶜ ∗ᶜ ♯ₗl @ R {{ _, s ↦C[LLvl] #1 ∗ l ↦C #1 }}.
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 }}.
CWP ♯ₗs1 =ᶜ ∗ᶜ ♯ₗl ;ᶜ ∗ᶜ ♯ₗs1 +ᶜ ♯42 @ R {{ _, s1 ↦C #1 ∗ l ↦C #1 }}.
Proof. iIntros. vcg. auto with iFrame. Qed.
(** double dereferencing & modification *)
Lemma test5 (l1 l2 r1 r2 : cloc) (v1 v2: val) :
l1 ↦C cloc_to_val l2 -∗ l2 ↦C v1 -∗
r1 ↦C cloc_to_val r2 -∗ r2 ↦C v2 -∗
AWP ♯ₗl1 =ᶜ ♯ₗr1 ;ᶜ ∗ᶜ ∗ᶜ ♯ₗl1
CWP ♯ₗ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. auto with iFrame. Qed.
......@@ -47,86 +47,86 @@ Section test.
(** par *)
Lemma test_par_1 (l1 l2 : cloc) (v1 v2: val) :
l1 ↦C v1 -∗ l2 ↦C v2 -∗
AWP ∗ᶜ ♯ₗl1 |||ᶜ ∗ᶜ ♯ₗl2
CWP ∗ᶜ ♯ₗl1 |||ᶜ ∗ᶜ ♯ₗl2
{{ w, ⌜w = (v1, v2)%V⌝ ∗ l1 ↦C v1 ∗ l2 ↦C v2 }}.
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)
CWP (♯ₗl1 =ᶜ c_ret v2) |||ᶜ (♯ₗl2 =ᶜ c_ret v1)
{{ w, ⌜w = (v2, v1)%V⌝ ∗ l1 ↦C[LLvl] v2 ∗ l2 ↦C[LLvl] v1 }}.
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] #(1 + z0) }}.
CWP ♯ₗ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
CWP (♯ₗ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)
CWP (♯ₗl =ᶜ ♯2 ;ᶜ ♯1 +ᶜ (♯ₗ l =ᶜ ♯1)) +ᶜ (♯ₗ s =ᶜ ♯4)
{{ 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 }}.
CWP (♯ₗl =ᶜ ♯2 ;ᶜ ∗ᶜ ♯ₗl) +ᶜ (♯ₗs =ᶜ ♯4) {{ v, ⌜v = #6⌝ ∧ s ↦C[LLvl] #4 ∗ l ↦C #2 }}.
Proof. iIntros. vcg. eauto with iFrame. Qed.
Lemma test_seq3 l :
l ↦C #0 -∗
AWP ♯ₗl =ᶜ ♯2 ;ᶜ ♯1 +ᶜ (♯ₗl =ᶜ ♯1) {{ _, l ↦C[LLvl] #1 }}.
CWP ♯ₗl =ᶜ ♯2 ;ᶜ ♯1 +ᶜ (♯ₗl =ᶜ ♯1) {{ _, l ↦C[LLvl] #1 }}.
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))
CWP (♯ₗl =ᶜ ♯2 ;ᶜ ♯1 +ᶜ (♯ₗl =ᶜ ♯1)) +ᶜ (♯ₗk =ᶜ ♯2 ;ᶜ ♯1 +ᶜ (♯ₗk =ᶜ ♯1))
{{ v, ⌜v = #4⌝ ∧ l ↦C[LLvl] #1 ∗ k ↦C[LLvl] #1 }}.
Proof. iIntros. vcg. eauto with iFrame. Qed.
Definition stupid (l : cloc) : expr :=
♯ₗ l =ᶜ ♯ 1;ᶜ a_ret #0.
♯ₗ l =ᶜ ♯ 1;ᶜ c_ret #0.
Lemma test_seq_fail l :
l ↦C[ULvl] #0 -∗
AWP (stupid l +ᶜ stupid l) +ᶜ (a_ret #0) {{ v, l ↦C #1 }}.
CWP (stupid l +ᶜ stupid l) +ᶜ (c_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 }}.
CWP ♯0 +ᶜ (♯ₗl =ᶜ ♯1 ;ᶜ ♯ₗk =ᶜ ♯2 ;ᶜ ♯0) {{ v, ⌜v = #0⌝ ∗ l ↦C #1 ∗ k ↦C #2 }}.
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))
CWP ♯1 +ᶜ (♯ₗl =ᶜ ♯1 ;ᶜ (♯ₗk =ᶜ ♯2) +ᶜ ∗ᶜ ♯ₗl ;ᶜ ∗ᶜ ♯ₗk +ᶜ (♯ₗl =ᶜ ♯2))
{{ v, ⌜v = #5⌝ ∗ l ↦C[LLvl] #2 ∗ k ↦C #2 }}.
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 }}.
CWP ♯1 +ᶜ (♯ₗl =ᶜ ♯1 ;ᶜ ∗ᶜ ♯ₗl +ᶜ ∗ᶜ ♯ₗl ;ᶜ ♯ₗl =ᶜ ♯2) {{ v, ⌜v = #3⌝ ∗ l ↦C[LLvl] #2 }}.
Proof. iIntros. vcg. eauto with iFrame. Qed.
(** while *)
Lemma test_while l R :
l ↦C #1 -∗
AWP whileᶜ (∗ᶜ ♯ₗl <ᶜ ♯2) { ♯ₗl =ᶜ ♯1 } @ R {{ _, True }}.
CWP whileᶜ (∗ᶜ ♯ₗl <ᶜ ♯2) { ♯ₗl =ᶜ ♯1 } @ R {{ _, True }}.
Proof.
iIntros. vcg. iIntros. iLöb as "IH".
iApply a_whileV_spec; iNext.
iApply cwp_whileV; iNext.
vcg. iIntros "Hl".
iLeft. iSplitR; eauto. iModIntro.
vcg. iIntros "Hl". iModIntro. by iApply "IH".
......
theories/tests/binop.v
View file @ bfa32cfe
From iris_c.vcgen Require Import proofmode.
Section test.
Context `{amonadG Σ}.
Context `{cmonadG Σ}.
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 }}.
CWP ∗ᶜ♯ₗq +∗ᶜ ♯n @ R {{ v, Φ v ∗ p ↦C v1 ∗ q ↦C cloc_to_val p }}.
Proof. iIntros. vcg. eauto with iFrame. Qed.
End test.
theories/tests/fact.v
View file @ bfa32cfe
From iris_c.vcgen Require Import proofmode.
Definition inc : val := λᶜ "l",
a_ret "l" +=ᶜ ♯1 ;ᶜ ♯ ().
c_ret "l" +=ᶜ ♯1 ;ᶜ ♯ ().
Definition factorial : val := λᶜ "n",
"r" ←mutᶜ ♯1;ᶜ
"c" ←mutᶜ ♯0;ᶜ
whileᶜ (∗ᶜ (a_ret "c") <ᶜ a_ret "n") {
callᶜ (a_ret inc) (a_ret "c");ᶜ
a_ret "r" =ᶜ ∗ᶜ (a_ret "r") *ᶜ ∗ᶜ (a_ret "c")
whileᶜ (∗ᶜ (c_ret "c") <ᶜ c_ret "n") {
callᶜ (c_ret inc) (c_ret "c");ᶜ
c_ret "r" =ᶜ ∗ᶜ (c_ret "r") *ᶜ ∗ᶜ (c_ret "c")
};ᶜ
∗ᶜ(a_ret "r").
∗ᶜ(c_ret "r").
Section factorial_spec.
Context `{amonadG Σ}.
Context `{cmonadG Σ}.
Lemma inc_spec l (n : Z) R Φ :
l ↦C #n -∗ (l ↦C #(1 + n) -∗ Φ #()) -∗
AWP inc (cloc_to_val l) @ R {{ Φ }}.
CWP inc (cloc_to_val l) @ R {{ Φ }}.
Proof.
iIntros "? H". iApply a_fun_spec; simpl. vcg; iIntros "? !>". by iApply "H".
iIntros "? H". iApply cwp_fun; simpl. vcg; iIntros "? !>". by iApply "H".
Qed.
Lemma factorial_spec (n: nat) R :
AWP factorial #n @ R {{ v, ⌜v = #(fact n)⌝ }}%I.
CWP factorial #n @ R {{ v, ⌜v = #(fact n)⌝ }}%I.
Proof.
iApply a_fun_spec; simpl. vcg. iIntros (r c) "**".
iApply (awp_wand _ (λ _, c ↦C #n ∗ r ↦C #(fact n))%I with "[-]"); last first.
iApply cwp_fun; simpl. vcg. iIntros (r c) "**".
iApply (cwp_wand _ (λ _, c ↦C #n ∗ r ↦C #(fact n))%I with "[-]"); last first.
{ iIntros (?) "[Hc Hr]". vcg_continue. eauto with iFrame. }
iAssert (∃ k : nat, ⌜k ≤ n⌝ ∧ c ↦C #k ∗ r ↦C #(fact k))%I with "[-]" as (k Hk) "[??]".
{ iExists 0%nat. eauto with lia iFrame. }
iLöb as "IH" forall (n k Hk). iApply a_whileV_spec; iNext.
iLöb as "IH" forall (n k Hk). iApply cwp_whileV; iNext.
vcg. iIntros "**". case_bool_decide.
+ iLeft. iSplit; eauto. iModIntro. vcg.
iIntros "Hc Hr !> $ !>". iApply (inc_spec with "Hc"); iIntros "Hc".
......
theories/tests/gcd.v
View file @ bfa32cfe
From iris_c.vcgen Require Import proofmode.
Definition gcd : val := λᶜ "x",
"a" ←ᶜ a_ret (Fst "x");ᶜ
"b" ←ᶜ a_ret (Snd "x");ᶜ
whileᶜ(∗ᶜ(a_ret "a") !=ᶜ ∗ᶜ(a_ret "b")) {
ifᶜ (∗ᶜ(a_ret "a") <ᶜ ∗ᶜ(a_ret "b")) {
(a_ret "b") =ᶜ ∗ᶜ(a_ret "b") -ᶜ ∗ᶜ(a_ret "a")
"a" ←ᶜ c_ret (Fst "x");ᶜ
"b" ←ᶜ c_ret (Snd "x");ᶜ
whileᶜ(∗ᶜ(c_ret "a") !=ᶜ ∗ᶜ(c_ret "b")) {
ifᶜ (∗ᶜ(c_ret "a") <ᶜ ∗ᶜ(c_ret "b")) {
(c_ret "b") =ᶜ ∗ᶜ(c_ret "b") -ᶜ ∗ᶜ(c_ret "a")
} elseᶜ {
(a_ret "a") =ᶜ ∗ᶜ(a_ret "a") -ᶜ ∗ᶜ(a_ret "b")
(c_ret "a") =ᶜ ∗ᶜ(c_ret "a") -ᶜ ∗ᶜ(c_ret "b")
}
};ᶜ ∗ᶜ(a_ret "a").
};ᶜ ∗ᶜ(c_ret "a").
Section gcd_spec.
Context `{amonadG Σ}.
Context `{cmonadG Σ}.
Lemma gcd_spec l r a b R :
0 ≤ a → 0 ≤ b →
l ↦C #a -∗ r ↦C #b -∗
AWP gcd (cloc_to_val l, cloc_to_val r)%V @ R {{ v, ⌜v = #(Z.gcd a b)⌝ }}.
CWP gcd (cloc_to_val l, cloc_to_val r)%V @ R {{ v, ⌜v = #(Z.gcd a b)⌝ }}.
Proof.
iIntros (??) "**". iApply a_fun_spec; simpl. vcg; iIntros.
iApply (a_whileV_inv_spec (∃ x y : Z,
iIntros (??) "**". iApply cwp_fun; simpl. vcg; iIntros.
iApply (cwp_whileV_inv (∃ x y : Z,
⌜0 ≤ x ∧ 0 ≤ y ∧ Z.gcd x y = Z.gcd a b⌝ ∧ l ↦C #x ∗ r ↦C #y)%I with "[-]").
{ iExists a, b. eauto with iFrame. }
iModIntro. iDestruct 1 as (x y (?&?&Hgcd)) "[??]". vcg. iIntros "** /=".
case_bool_decide; simpl; [iLeft | iRight]; iSplit; eauto.
+ repeat iModIntro. vcg_continue. simplify_eq/=.
rewrite -Hgcd Z.gcd_diag Z.abs_eq; eauto with iFrame.
+ iModIntro. iApply a_if_spec. vcg. iIntros "** /=".
+ iModIntro. iApply cwp_if. vcg. iIntros "** /=".
case_bool_decide; simpl; [ iLeft | iRight ];
(iSplit; first done); iModIntro.
* vcg. iIntros "** !>". iExists x, (y - x); iFrame.
......
theories/tests/invoke.v
View file @ bfa32cfe
(** Testing function calls and AWP resources *)
(** Testing function calls and CWP resources *)
From iris_c.vcgen Require Import proofmode.
Section tests_vcg.
Context `{amonadG Σ}.
Context `{cmonadG Σ}.
Definition c_id : val := λ: "v", a_ret "v".
Definition c_id : val := λ: "v", c_ret "v".
Lemma test_invoke_1 (l: cloc) R :
l ↦C #42 -∗
AWP callᶜ (a_ret c_id) (∗ᶜ ♯ₗl) @ R {{ v, ⌜v = #42⌝ ∗ l ↦C #42 }}%I.
CWP callᶜ (c_ret c_id) (∗ᶜ ♯ₗl) @ R {{ v, ⌜v = #42⌝ ∗ l ↦C #42 }}%I.
Proof.
iIntros "Hl". vcg. iIntros "Hl !> $ !>".
awp_lam. vcg. iIntros "Hl". vcg_continue. eauto.
cwp_lam. vcg. iIntros "Hl". vcg_continue. eauto.
Qed.
Definition plus_pair : val := λ: "vv",
"v1" ←ᶜ a_ret (Fst "vv");ᶜ
"v2" ←ᶜ a_ret (Snd "vv");ᶜ
(a_ret "v1") +ᶜ (a_ret "v2").
"v1" ←ᶜ c_ret (Fst "vv");ᶜ
"v2" ←ᶜ c_ret (Snd "vv");ᶜ
(c_ret "v1") +ᶜ (c_ret "v2").
Lemma test_invoke_2 R :
AWP callᶜ (a_ret plus_pair) (♯21 |||ᶜ ♯21) @ R {{ v, ⌜v = #42⌝ }}%I.
CWP callᶜ (c_ret plus_pair) (♯21 |||ᶜ ♯21) @ R {{ v, ⌜v = #42⌝ }}%I.
Proof.
iIntros. vcg. iIntros "!> $ !>". awp_lam. vcg. by vcg_continue.
iIntros. vcg. iIntros "!> $ !>". cwp_lam. vcg. by vcg_continue.
Qed.
Lemma test_invoke_3 (l : cloc) R :
l ↦C #21 -∗
AWP callᶜ (a_ret plus_pair) (∗ᶜ ♯ₗl |||ᶜ ∗ᶜ ♯ₗl) @ R
CWP callᶜ (c_ret plus_pair) (∗ᶜ ♯ₗl |||ᶜ ∗ᶜ ♯ₗl) @ R
{{ v, ⌜v = #42⌝ ∗ l ↦C #21 }}%I.
Proof.
iIntros. vcg. iIntros "Hl !> $ !>". awp_lam. vcg.
iIntros. vcg. iIntros "Hl !> $ !>". cwp_lam. vcg.
iIntros "Hl". vcg_continue; eauto.
Qed.
End tests_vcg.
theories/tests/lists.v
View file @ bfa32cfe
(** TODO: this file should be updated to not break the C-language abstraction *)
From iris_c.vcgen Require Import proofmode.
Definition a_list_nil : val := λ:<>, a_ret NONEV.
Definition a_list_nil : val := λ:<>, c_ret NONEV.
Definition a_list_data : val := λ: "x",
a_bind (λ: "s",
c_bind (λ: "s",
match: "s" with
NONE => assert: #false
| SOME "l" => (a_bind (λ: "p", a_ret (Fst "p")) (a_load (a_ret "l")))
| SOME "l" => (c_bind (λ: "p", c_ret (Fst "p")) (c_load (c_ret "l")))
end) "x".
Definition a_list_next : val := λ: "x",
a_bind (λ: "s",
c_bind (λ: "s",
match: "s" with
NONE => assert: #false
| SOME "l" => (a_bind (λ: "p", a_ret (Snd "p")) (a_load (a_ret "l")))
| SOME "l" => (c_bind (λ: "p", c_ret (Snd "p")) (c_load (c_ret "l")))
end) "x".
(* TODO: generalize the function below to set an arbitrary node in the list *)
Definition a_list_set_next : val := λ: "x" "y",
a_bind (λ: "xs",
c_bind (λ: "xs",
match: "xs" with
NONE => assert: #false
| SOME "l" =>
a_bind (λ:"p",
a_bind ( λ: "r",
a_store (a_ret "l") (a_ret (Fst "p", "r")))
(a_load "y"))
(a_load (a_ret "l"))
c_bind (λ:"p",
c_bind ( λ: "r",
c_store (c_ret "l") (c_ret (Fst "p", "r")))
(c_load "y"))
(c_load (c_ret "l"))
end) "x".
Definition a_list_store_next : val := λ: "x1" "x2",
a_bind (λ: "p",
c_bind (λ: "p",
match: Fst "p" with
NONE => assert: #false
| SOME "l" => a_bind (λ:"m", a_store (a_ret "l") (a_ret (Fst "m", Snd "p")))
(a_load (a_ret "l"))
| SOME "l" => c_bind (λ:"m", c_store (c_ret "l") (c_ret (Fst "m", Snd "p")))
(c_load (c_ret "l"))
end)
(a_par "x1" "x2").
(c_par "x1" "x2").
Definition in_place_reverse : val := λ: "hd",
a_bind (λ: "i", a_bind (λ: "j",
c_bind (λ: "i", a_bind (λ: "j",
a_while
(λ:<>, a_un_op NegOp (a_bin_op EqOp (a_load (a_ret "i")) (a_ret NONEV)))
(λ:<>, a_bind (λ: "k",
a_list_store_next (a_load (a_ret "i")) (a_load (a_ret "j")) ;ᶜ
a_store (a_ret "j") (a_load (a_ret "i")) ;ᶜ
a_store (a_ret "i") (a_load (a_ret "k")))
(a_alloc ♯1 (a_list_next (a_load (a_ret "i"))))) ;ᶜ
(a_load (a_ret "j"))
) (a_alloc ♯1 (a_ret NONEV))) (a_alloc ♯1 (a_ret "hd")).
(λ:<>, a_un_op NegOp (c_bin_op EqOp (c_load (c_ret "i")) (c_ret NONEV)))
(λ:<>, c_bind (λ: "k",
a_list_store_next (c_load (c_ret "i")) (a_load (c_ret "j")) ;ᶜ
c_store (c_ret "j") (c_load (c_ret "i")) ;ᶜ
c_store (c_ret "i") (c_load (c_ret "k")))
(a_alloc ♯1 (a_list_next (c_load (c_ret "i"))))) ;ᶜ
(c_load (c_ret "j"))
) (a_alloc ♯1 (c_ret NONEV))) (a_alloc ♯1 (c_ret "hd")).
Section list_spec.
Context `{amonadG Σ}.
Context `{cmonadG Σ}.
Fixpoint is_list (hd : val) (xs : list val) : iProp Σ :=
match xs with
......@@ -61,55 +61,55 @@ Section list_spec.
end%I.
Lemma a_list_nil_spec R Φ:
Φ NONEV -∗ awp (a_list_nil #()) R Φ.
Proof. iIntros "H"; awp_lam; by awp_ret_value. Qed.
Φ NONEV -∗ cwp (a_list_nil #()) R Φ.
Proof. iIntros "H"; cwp_lam; by cwp_ret_value. Qed.
Lemma a_list_next_spec (e: expr) R Φ :
awp e R (λ v,
cwp e R (λ v,
∃ (l:cloc) hd x xs, ⌜v = SOMEV (cloc_to_val l)⌝ ∧ l ↦C (x, hd) ∗ is_list hd xs ∗
(l ↦C (x, hd) -∗ is_list hd xs -∗ Φ hd)) -∗
awp (a_list_next e) R Φ.
cwp (a_list_next e) R Φ.
Proof.
iIntros "H". rewrite/ a_list_next.
awp_apply (a_wp_awp R with "H").
- iIntros (v) "H". awp_lam. iApply awp_bind. iApply (awp_wand with "H").
cwp_apply (cwp_cwp R with "H").
- iIntros (v) "H". cwp_lam. iApply cwp_bind. iApply (cwp_wand with "H").
iIntros (v0) "H". iDestruct "H" as (i hd x xs) "[-> [Hi [Hlst HΦ]]]".
awp_let. awp_match. iApply awp_bind.
awp_load_ret i. iIntros "Hi". iSpecialize ("HΦ" with "Hi Hlst").
awp_let. iApply awp_ret. wp_proj. iFrame.
cwp_let. cwp_match. iApply cwp_bind.
cwp_load_ret i. iIntros "Hi". iSpecialize ("HΦ" with "Hi Hlst").
cwp_let. iApply cwp_ret. wp_proj. iFrame.
Qed.
End list_spec.
Section in_place_reversal.
Context `{amonadG Σ}.
Context `{cmonadG Σ}.
Lemma a_list_store_next_spec e1 e2 Ψ1 Ψ2 R Φ :
awp e1 R (λ v, ∃ (hd:cloc) x old,
cwp e1 R (λ v, ∃ (hd:cloc) x old,
⌜v = SOMEV (cloc_to_val hd)⌝ ∧ hd ↦C (x, old) ∗ Ψ1 (x, SOMEV (cloc_to_val hd))) -∗
awp e2 R Ψ2 -∗
cwp e2 R Ψ2 -∗
(∀ (hd : cloc) x new, Ψ1 (x, SOMEV (cloc_to_val hd)) -∗ Ψ2 new -∗