Commit fc8c86f6 authored by Dan Frumin's avatar Dan Frumin

Use Iris' PureExec typeclass

parent 08bc474f
......@@ -373,7 +373,7 @@ Module lang.
Lemma alloc_fresh e v σ :
let l := fresh (dom (gset loc) σ) in
to_val e = Some v head_step (Alloc e) σ (Lit (Loc l)) (<[l:=v]>σ) [].
Proof. by intros; apply AllocS, (not_elem_of_dom (D:=gset _)), is_fresh. Qed.
Proof. by intros; apply AllocS, (not_elem_of_dom (D:=gset loc)), is_fresh. Qed.
End lang.
(** Language instance for Iris *)
......
From iris_logrel.prelude Require Export hax.
From iris_logrel.F_mu_ref_conc Require Export lang subst notation.
Class PureExec (P : Prop) (e1 e2 : expr) := {
pure_exec_safe : P -> σ, head_reducible e1 σ;
pure_exec_puredet : P -> σ1 e2' σ2 efs, head_step e1 σ1 e2' σ2 efs -> σ1=σ2 /\ e2=e2' /\ [] = efs;
}.
(* DF: Some tactics will loop pretty badly and consume lots of memory if you make this an instance *)
Lemma PureExec_Closed P e1 e2 `{HP: PureExec P e1 e2} `{Hcl : Closed X e1} : P -> Closed X e2.
Proof.
destruct HP as [Hpure Hstep].
intros p. specialize (Hpure p). specialize (Hstep p).
specialize (Hpure inhabitant).
unfold head_reducible in *.
destruct Hpure as (e' & σ' & efs & Hst).
destruct (Hstep inhabitant e' σ' efs Hst) as (? & ? & ?); subst.
destruct e1; inv_head_step;
unfold Closed in *; simpl in Hcl; simpl;
destruct_and?; split_and?; eauto.
- apply Closed_mono with ; [ | set_solver ].
destruct f, x; simpl in *; eauto;
repeat apply is_closed_subst_preserve; eauto;
try apply of_val_closed.
- apply of_val_closed'.
Qed.
Local Ltac solve_exec_safe := intros; subst; do 3 eexists; econstructor; eauto.
Local Ltac solve_exec_puredet := simpl; intros; by inv_head_step.
Local Ltac solve_pureexec :=
apply hoist_pred_pureexec; intros; destruct_and?;
apply det_head_step_pureexec; [ solve_exec_safe | solve_exec_puredet ].
Instance pure_binop op e1 v1 e2 v2 v `(to_val e1 = Some v1) `(to_val e2 = Some v2):
PureExec (binop_eval op v1 v2 = Some v)
(BinOp op e1 e2)
(of_val v).
Proof.
split; intros Hval.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
Instance pure_rec f x e1 e2 v2 `{Closed (Rec f x e1)} `(to_val e2 = Some v2) :
PureExec True
(App (Rec f x e1) e2)
(subst' f (Rec f x e1) (subst' x e2 e1)).
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
(* TODO: give this one a correct priority? *)
Instance pure_rec_locked e f x e1 e2 v2 `(to_val e2 = Some v2) `(e = Rec f x e1) `{Closed (x :b: f :b: ) e1} :
......@@ -51,81 +25,46 @@ Instance pure_rec_locked e f x e1 e2 v2 `(to_val e2 = Some v2) `(e = Rec f x e1)
(App e e2)
(e $/ v2) | 100.
Proof.
split; intros ?; subst.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. destruct f; by inv_head_step.
apply hoist_pred_pureexec; intros; destruct_and?;
apply det_head_step_pureexec.
- solve_exec_safe.
- destruct f; solve_exec_puredet.
Qed.
Instance pure_fst e1 v1 e2 v2 `(to_val e1 = Some v1) `(to_val e2 = Some v2) :
PureExec True (Fst (Pair e1 e2)) e1.
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
Instance pure_snd e1 v1 e2 v2 `(to_val e1 = Some v1) `(to_val e2 = Some v2) :
PureExec True (Snd (Pair e1 e2)) e2.
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
Instance pure_unfold e1 v1 `(to_val e1 = Some v1) :
PureExec True (Unfold (Fold e1)) e1.
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
Instance pure_unpack e1 e2 v1 `(to_val e1 = Some v1) :
PureExec True (Unpack (Pack e1) e2) (e2 e1).
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
Instance pure_if_true e1 e2 :
PureExec True (If #true e1 e2) e1.
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
Instance pure_if_false e1 e2 :
PureExec True (If #false e1 e2) e2.
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
Instance pure_case_inl e0 v `(to_val e0 = Some v) e1 e2 :
PureExec True (Case (InjL e0) e1 e2) (e1 e0).
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
Instance pure_case_inr e0 v `(to_val e0 = Some v) e1 e2 :
PureExec True (Case (InjR e0) e1 e2) (e2 e0).
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
Instance pure_tlam e `{Closed e} :
PureExec True
(TApp (TLam e))
e.
Proof.
split; intros ?.
- intros. do 3 eexists. econstructor; eauto using to_of_val.
- intros. by inv_head_step.
Qed.
Proof. solve_pureexec. Qed.
......@@ -231,12 +231,16 @@ Ltac solve_to_val :=
| |- to_val ?e = Some ?v =>
let e' := R.of_expr e in change (to_val (R.to_expr e') = Some v);
apply R.to_val_Some; simpl; unfold R.to_expr; unlock; reflexivity
| |- IntoVal ?e ?v =>
let e' := R.of_expr e in change (to_val (R.to_expr e') = Some v);
apply R.to_val_Some; simpl; unfold R.to_expr; reflexivity
| |- is_Some (to_val ?e) =>
let e' := R.of_expr e in change (is_Some (to_val (R.to_expr e')));
apply R.to_val_is_Some, (bool_decide_unpack _); vm_compute; exact I
end.
Hint Extern 0 (to_val _ = Some _) => solve_to_val : typeclass_instances.
Hint Extern 0 (is_Some (to_val _)) => solve_to_val : typeclass_instances.
Hint Extern 0 (IntoVal _ _) => solve_to_val : typeclass_instances.
Ltac solve_closed :=
match goal with
......
......@@ -4,7 +4,7 @@ From iris.base_logic Require Export invariants big_op.
From iris.algebra Require Import auth frac agree gmap.
From iris.proofmode Require Import tactics.
From iris.base_logic Require Export gen_heap.
From iris_logrel.F_mu_ref_conc Require Export lang notation pureexec.
From iris_logrel.F_mu_ref_conc Require Export lang notation pureexec reflection.
Import uPred.
(** The CMRA for the heap of the implementation. This is linked to the
......@@ -108,15 +108,7 @@ Section lang_rules.
PureExec φ e1 e2
φ
WP e2 @ E {{ Φ }} WP e1 @ E {{ Φ }}.
Proof.
iIntros (? Hφ) "HWP".
iApply (wp_lift_pure_det_head_step_no_fork' with "HWP").
{ destruct (pure_exec_safe Hφ ) as (e' & σ' & efs & Hst).
eapply val_stuck.
apply Hst. }
{ apply (pure_exec_safe Hφ). }
{ apply (pure_exec_puredet Hφ). }
Qed.
Proof. apply wp_pure_step_later. Qed.
Lemma wp_rec E f x erec e1 e2 Φ :
e1 = Rec f x erec
......@@ -125,7 +117,7 @@ Section lang_rules.
WP subst' f e1 (subst' x e2 erec) @ E {{ Φ }} WP App e1 e2 @ E {{ Φ }}.
Proof.
iIntros (? [v ?] ?) "HWP". subst.
iApply (wp_pure with "HWP"); [ eapply pure_rec | exact I ]; eauto.
iApply (wp_pure with "HWP"); eauto.
Qed.
Lemma wp_tlam E e Φ {Hcl: Closed e} : WP e @ E {{ Φ }} WP TApp (TLam e) @ E {{ Φ }}.
......@@ -133,90 +125,15 @@ Section lang_rules.
rewrite -(wp_lift_pure_det_head_step_no_fork (TApp _) e); eauto.
intros; inv_head_step; eauto.
Qed.
Lemma wp_fold E e v Φ :
to_val e = Some v (|={E}=> Φ v) WP Unfold (Fold e) @ E {{ Φ }}.
Proof.
intros <-%of_to_val.
rewrite -(wp_lift_pure_det_head_step_no_fork (Unfold _) (of_val v))
-?wp_value_fupd; eauto.
intros; inv_head_step; eauto.
Qed.
Lemma wp_pack E e1 e2 v Φ :
to_val e1 = Some v
WP (App e2 e1) @ E {{ Φ }} WP Unpack (Pack e1) e2 @ E {{ Φ }}.
Proof.
intros <-%of_to_val.
rewrite -(wp_lift_pure_det_head_step_no_fork (Unpack _ _) _); eauto.
intros; inv_head_step; eauto.
Qed.
Lemma wp_fst E e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2
(|={E}=> Φ v1) WP Fst (Pair e1 e2) @ E {{ Φ }}.
Proof.
intros. rewrite -(wp_lift_pure_det_head_step_no_fork (Fst _) e1)
-?wp_value_fupd; eauto.
intros; inv_head_step; eauto.
Qed.
Lemma wp_snd E e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2
(|={E}=> Φ v2) WP Snd (Pair e1 e2) @ E {{ Φ }}.
Proof.
intros. rewrite -(wp_lift_pure_det_head_step_no_fork (Snd _) e2)
-?wp_value_fupd; eauto.
intros; inv_head_step; eauto.
Qed.
Lemma wp_case_inl E e0 v0 e1 e2 Φ :
to_val e0 = Some v0
WP App e1 e0 @ E {{ Φ }} WP Case (InjL e0) e1 e2 @ E {{ Φ }}.
Proof.
intros. rewrite -(wp_lift_pure_det_head_step_no_fork (Case _ _ _) _); eauto.
intros; inv_head_step; eauto.
Qed.
Lemma wp_case_inr E e0 v0 e1 e2 Φ :
to_val e0 = Some v0
WP App e2 e0 @ E {{ Φ }} WP Case (InjR e0) e1 e2 @ E {{ Φ }}.
Proof.
intros. rewrite -(wp_lift_pure_det_head_step_no_fork (Case _ _ _)); eauto.
intros; inv_head_step; eauto.
Qed.
Lemma wp_fork E e Φ :
(|={E}=> Φ #()) WP e {{ _, True }} WP Fork e @ E {{ Φ }}.
Proof.
rewrite -(wp_lift_pure_det_head_step (Fork e) #() [e]) //=; eauto.
- rewrite -(wp_value_fupd _ _ #()); auto.
by rewrite -step_fupd_intro // right_id later_sep.
- intros; inv_head_step; eauto.
Qed.
Lemma wp_if_true E e1 e2 Φ :
WP e1 @ E {{ Φ }} WP If #true e1 e2 @ E {{ Φ }}.
Proof.
rewrite -(wp_lift_pure_det_head_step_no_fork (If _ _ _) e1); eauto.
intros; inv_head_step; eauto.
Qed.
Lemma wp_if_false E e1 e2 Φ :
WP e2 @ E {{ Φ }} WP If #false e1 e2 @ E {{ Φ }}.
Proof.
rewrite -(wp_lift_pure_det_head_step_no_fork (If _ _ _) e2); eauto.
intros; inv_head_step; eauto.
rewrite -(wp_lift_pure_det_head_step (Fork e) #() [e]) //=; eauto.
- (* TODO typeclass inference fail *)
erewrite <-(wp_value_fupd _ _ #()); eauto; last solve_to_val.
by rewrite -step_fupd_intro // right_id later_sep.
- intros; inv_head_step; eauto.
Qed.
Lemma wp_nat_binop E op e1 e2 v1 v2 v Φ :
to_val e1 = Some v1
to_val e2 = Some v2
binop_eval op v1 v2 = Some v
(|={E}=> Φ v) WP BinOp op e1 e2 @ E {{ Φ }}.
Proof.
intros. rewrite -(wp_lift_pure_det_head_step_no_fork (BinOp op _ _) (of_val _))
-?wp_value_fupd'; eauto.
intros; inv_head_step; eauto.
Qed.
End lang_rules.
......@@ -413,6 +413,26 @@ Proof.
[ apply lookup_delete | rewrite delete_commute ; apply lookup_delete ].
Qed.
(** Properties of the context substitution *)
Lemma fill_item_subst_p (es : stringmap val) (Ki : ectx_item) (e : expr) :
subst_p es (fill_item Ki e) = fill_item (subst_ctx_item es Ki) (subst_p es e).
Proof.
induction Ki; simpl;
rewrite ?of_val_subst_p; eauto.
Qed.
Lemma fill_subst (es : stringmap val) (K : list ectx_item) (e : expr) :
subst_p es (fill K e) = fill (subst_ctx es K) (subst_p es e).
Proof.
generalize dependent e. generalize dependent es.
induction K as [|Ki K]; eauto.
intros es e. simpl.
rewrite IHK.
by rewrite ?fill_item_subst_p.
Qed.
(** Substitutions and reductions *)
Lemma subst_p_head_step e e' vs efs σ σ' :
head_step e σ e' σ' efs
head_step (subst_p vs e) σ (subst_p vs e') σ' (subst_p vs <$> efs).
......@@ -438,7 +458,18 @@ Proof.
- econstructor. by rewrite Closed_subst_p_id.
Qed.
Lemma subst_p_safe e es :
Lemma subst_p_prim_step e e' vs efs σ σ' :
prim_step e σ e' σ' efs
prim_step (subst_p vs e) σ (subst_p vs e') σ' (subst_p vs <$> efs).
Proof.
intros Hst.
destruct Hst as [K e1 e2 ?? Hst]; subst.
rewrite !fill_subst.
eapply Ectx_step with (subst_ctx vs K) (subst_p vs e1) (subst_p vs e2); eauto.
simpl. by apply subst_p_head_step.
Qed.
Lemma subst_p_safe_head e es :
( σ, head_reducible e σ) ( σ, head_reducible (subst_p es e) σ).
Proof.
rewrite /head_reducible.
......@@ -447,7 +478,19 @@ Proof.
do 3 eexists. apply subst_p_head_step; eauto.
Qed.
Lemma subst_p_det e e' es :
Lemma subst_p_safe e es :
( σ, reducible e σ) ( σ, reducible (subst_p es e) σ).
Proof.
rewrite /reducible.
intros Hsafe.
intros σ. destruct (Hsafe σ) as (e' & σ' & efs & Hstep).
destruct Hstep as [K ? ? ? ? Hstep]. subst.
do 3 eexists. rewrite fill_subst.
eapply Ectx_step; eauto.
apply subst_p_head_step; eauto.
Qed.
Lemma subst_p_det_head e e' es :
( σ, head_step e σ e' σ [])
( σ1 e2 σ2 efs, head_step e σ1 e2 σ2 efs -> σ1=σ2 /\ e'=e2 /\ [] = efs)
( σ1 e2 σ2 efs, head_step (subst_p es e) σ1 e2 σ2 efs -> σ1=σ2 /\ (subst_p es e')=e2 /\ [] = efs).
......@@ -482,20 +525,71 @@ Proof.
by simplify_eq.
Qed.
(** Properties of the context substitution *)
Lemma fill_item_subst_p (es : stringmap val) (Ki : ectx_item) (e : expr) :
subst_p es (fill_item Ki e) = fill_item (subst_ctx_item es Ki) (subst_p es e).
Proof.
induction Ki; simpl;
rewrite ?of_val_subst_p; eauto.
Qed.
Lemma subst_p_det e e' es :
( σ, prim_step e σ e' σ [])
( σ1 e2 σ2 efs, prim_step e σ1 e2 σ2 efs -> σ1=σ2 /\ e'=e2 /\ [] = efs)
( σ1 e2 σ2 efs, prim_step (subst_p es e) σ1 e2 σ2 efs -> σ1=σ2 /\ (subst_p es e')=e2 /\ [] = efs).
Proof. admit. Admitted.
(* intros Hstep Hdet σ1 e2 σ2 efs Hst. *)
(* assert (Hstep' := Hstep). *)
(* specialize (Hdet σ1). *)
(* specialize (Hstep σ1). *)
(* destruct Hstep as [K0 e0 e0' ?? Hstep]. subst. simpl in *. *)
(* rewrite fill_subst in Hst. *)
(* rewrite fill_subst. *)
(* destruct Hst as [K1 t0 t2 Hfill ? Hst]. subst. simpl in *. *)
(* assert (to_val (subst_p es e0) = None) as Hnoval. *)
(* { pose (Hstuck:=val_prim_stuck). *)
(* simpl in Hstuck. *)
(* eapply Hstuck. *)
(* apply head_prim_step. *)
(* by apply subst_p_head_step. } *)
(* destruct (step_by_val _ _ _ _ _ _ _ _ Hfill Hnoval Hst) *)
(* as [K2 Hctx]. subst. clear Hnoval. *)
(* rewrite fill_app in Hfill. *)
(* apply fill_inj in Hfill. *)
(* rewrite fill_app. *)
(* inversion Hstep; subst; simplify_eq/=. *)
(* Focus 3. *)
(* inversion Hst; subst; simplify_eq/=. *)
(* split_and!; eauto. *)
(* f_equal. *)
(* rewrite -(of_to_val _ _ H0). *)
(* rewrite -(of_to_val _ _ H1). *)
(* inversion Hstep; subst; simplify_eq/=. *)
(* inversion Hfill. *)
(* apply fill_inj. *)
(* repeat (split; eauto). *)
(* apply *)
(* simpl in Hst. *)
(* simpl in Hst. *)
(* simpl in Hst; inversion Hst; simplify_eq/=; eauto; *)
Lemma fill_subst (es : stringmap val) (K : list ectx_item) (e : expr) :
subst_p es (fill K e) = fill (subst_ctx es K) (subst_p es e).
Proof.
generalize dependent e. generalize dependent es.
induction K as [|Ki K]; eauto.
intros es e. simpl.
rewrite IHK.
by rewrite ?fill_item_subst_p.
Qed.
(* inversion Hstep; subst; simplify_eq/=; *)
(* simpl in Hst; inversion Hst; simplify_eq/=; eauto; *)
(* repeat lazymatch goal with *)
(* | [ H : to_val ?e = Some ?v, H' : to_val (subst_p es ?e) = Some ?v2 |- _ ] => *)
(* rewrite -(of_to_val _ _ H) in H'; *)
(* rewrite of_val_subst_p in H'; *)
(* rewrite to_of_val in H' *)
(* | [ H : to_val ?e = Some ?v, H' : context[subst_p _ ?e] |- _ ] => *)
(* rewrite -(of_to_val _ _ H) in H'; *)
(* rewrite of_val_subst_p in H'; *)
(* rewrite (of_to_val _ _ H) in H' *)
(* end; simplify_eq/=; *)
(* rewrite ?of_val_subst_p; *)
(* split_and !; eauto. *)
(* - rewrite !subst_p_delete. *)
(* rewrite !(delete_commute_binder _ f x). *)
(* rewrite (Closed_subst_p_id' _ _ e1); eauto. *)
(* rewrite (to_val_subst_p e0 v0 _); eauto. *)
(* apply elem_of_rec_lookup. *)
(* - destruct (Hdet _ _ _ Hst) as (?&?&?). *)
(* by simplify_eq. *)
(* - destruct (Hdet _ _ _ Hst) as (?&?&?). *)
(* by simplify_eq. *)
(* - destruct (Hdet _ _ _ Hst) as (?&?&?). *)
(* by simplify_eq. *)
(* apply subst_p_det_head. *)
From iris.program_logic Require Export weakestpre.
From iris.program_logic Require Export weakestpre lifting.
From iris.proofmode Require Export tactics coq_tactics.
From iris_logrel.F_mu_ref_conc Require Export rules lang reflection.
Set Default Proof Using "Type".
......@@ -97,9 +97,9 @@ Tactic Notation "wp_bind" open_constr(efoc) :=
(** * Symbolic execution WP tactics *)
(** ** Pure reductions *)
Lemma tac_wp_pure `{heapG Σ} K φ e1 e2 1 2 E Φ :
IntoLaterNEnvs 1 1 2
PureExec φ e1 e2
φ
IntoLaterNEnvs 1 1 2
(2 WP fill K e2 @ E {{ Φ }})
(1 WP fill K e1 @ E {{ Φ }}).
Proof.
......@@ -108,7 +108,7 @@ Proof.
rewrite Hgoal.
iIntros "HWP".
wp_bind_core K.
iApply wp_pure; eauto.
iApply wp_pure_step_later; eauto.
iApply (wp_bind_inv with "HWP").
{ (* TODO: how to get rid of this? *)
change lang with (ectx_lang expr).
......@@ -122,9 +122,9 @@ Tactic Notation "wp_pure" open_constr(efoc) :=
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
unify e' efoc;
eapply (tac_wp_pure K);
[apply _ (* IntoLaters *)
|apply _ (* PureExec *)
[apply _ (* PureExec *)
|try (exact I || reflexivity || tac_rel_done)
|apply _ (* IntoLaters *)
|simpl_subst/= (* new goal *)])
end.
......
......@@ -86,7 +86,7 @@ Section CG_Counter.
unfold FG_increment. unlock.
iApply wp_rec; eauto.
iNext. simpl.
iApply wp_value; eauto. simpl. by rewrite decide_left.
iApply wp_value; eauto.
iApply wp_rec; eauto.
iNext. simpl.
wp_bind (Load (# x)).
......@@ -95,11 +95,12 @@ Section CG_Counter.
iApply wp_rec; eauto.
iNext. simpl.
wp_bind (BinOp _ _ _).
iApply (wp_nat_binop);eauto. iNext. iModIntro. simpl.
wp_binop.
iApply wp_value.
wp_bind (CAS _ _ _).
iApply (wp_cas_suc with "[Hx]"); auto.
iNext. iIntros "Hx".
iApply wp_if_true. iNext.
wp_if.
iApply wp_value; auto.
by iApply "Hlog".
Qed.
......
......@@ -67,6 +67,17 @@ Section proof.
iApply ("Hlog" with "Hl").
Qed.
Lemma bin_log_related_newlock_l Γ K t τ :
( l : loc, l ↦ᵢ #false - {E1,E1;Δ;Γ} fill K #l log t : τ) -
{E1,E1;Δ;Γ} fill K (newlock #()) log t : τ.
Proof.
iIntros "Hlog".
unfold newlock. unlock.
rel_rec_l.
rel_alloc_l as l "Hl".
iApply ("Hlog" with "Hl").
Qed.
Global Opaque newlock.
Transparent acquire.
......@@ -96,7 +107,42 @@ Section proof.
rel_if_r.
by iApply "Hlog".
Qed.
Lemma bin_log_related_acquire_suc_l Γ K l t τ :
l ↦ᵢ #false -
(l ↦ᵢ #true - {E1,E1;Δ;Γ} fill K (#()) log t : τ) -
{E1,E1;Δ;Γ} fill K (acquire #l) log t : τ.
Proof.
iIntros "Hl Hlog".
unfold acquire. unlock.
rel_rec_l.
rel_cas_l_atomic. iModIntro.
iExists _; iFrame "Hl".
iSplitR.
{ iIntros (Hfoo). congruence. }
iIntros (_). iNext. iIntros "Hl".
rel_if_l.
by iApply "Hlog".
Qed.
Lemma bin_log_related_acquire_fail_l Γ K l t τ :
l ↦ᵢ #true -
(l ↦ᵢ #false - {E1,E1;Δ;Γ} fill K (acquire #l) log t : τ) -
{E1,E1;Δ;Γ} fill K (acquire #l) log t : τ.
Proof.
iIntros "Hl Hlog".
iLöb as "IH".
unfold acquire. unlock.
rel_rec_l.
rel_cas_l_atomic. iModIntro.
iExists _; iFrame "Hl".
iSplitL; last first.
{ iIntros (Hfoo). congruence. }
iIntros (_). iNext. iIntros "Hl".
rel_if_l.
iApply ("IH" with "Hl Hlog").
Qed.
Global Opaque acquire.
Transparent release.
......
......@@ -107,9 +107,9 @@ Section stack_works.
{ iExists r, (FoldV NONEV); iFrame; iSplit; auto. iApply is_stack_unfold; iLeft; done. }
unlock pop_st. do 2 wp_rec.
unlock push_st. do 2 wp_rec.
iApply wp_value.
wp_value; last first.
(* TODO: solve_to_val. either doesn't work or too slow *)
{ simpl. rewrite ?decide_left.
{ rewrite /IntoVal /= ?decide_left.
simpl. done. }
iApply "HΦ".
(* The verification of pop *)
......@@ -125,7 +125,7 @@ Section stack_works.
subst.
simpl. wp_case_inr. (* TODO: we require a simpl here *)
wp_let.
wp_value.
iApply wp_value.
iLeft; iExists v'; auto.
+ iDestruct "H" as "%"; subst.
wp_case.
......@@ -141,7 +141,7 @@ Section stack_works.
iDestruct "Heq" as "[H | H]".
* iRewrite "H".
wp_unfold.
wp_case. wp_seq. wp_value.
wp_case. wp_seq. iApply wp_value.
iRight; auto.
* iDestruct "H" as (h t) "H"; iRewrite "H".
simpl. wp_unfold.
......@@ -162,7 +162,7 @@ Section stack_works.
iModIntro.
wp_if.
wp_proj.
wp_value. iLeft; auto.
iApply wp_value. iLeft; auto.
++ (* The case in which we fail *)
wp_cas_fail.
iMod ("Hclose" with "[Hl'' Hstack]").
......@@ -204,7 +204,7 @@ Section stack_works.
iExists v'', v'; iFrame. eauto. }
iModIntro.
wp_if.
by wp_value.
by iApply wp_value.
+ wp_cas_fail.
iMod ("Hclose" with "[Hl'' Hstack]").
iExists l''', v'''; iFrame; auto.
......@@ -215,6 +215,6 @@ Section stack_works.
iDestruct "H" as "%"; subst.
wp_case.
wp_seq.
by wp_value.
by iApply wp_value.
Qed.
End stack_works.
......@@ -99,7 +99,7 @@ Section side_channel.
iModIntro.
wp_if.
wp_proj.
wp_value.
iApply wp_value.
iLeft.
iExists v'; iSplit; auto.
- wp_cas_fail.
......@@ -107,7 +107,7 @@ Section side_channel.
iRight; iLeft; auto.
iModIntro.
wp_if.
wp_value.
iApply wp_value.
iRight; auto.
- iDestruct "H" as "[Hl H]".
wp_cas_fail.
......@@ -134,7 +134,7 @@ Section side_channel.
iModIntro.
wp_if.
wp_proj.
wp_value.
iApply wp_value.
iLeft.
auto.
- wp_cas_fail.
......@@ -142,14 +142,14 @@ Section side_channel.
iRight; iLeft; done.
iModIntro.
wp_if.
wp_value; auto.
iApply wp_value; auto.
- iDestruct "H" as "[Hl Hγ]".
wp_cas_fail.
iMod ("Hclose" with "[Hl Hγ]").
iRight; iRight; iFrame.
iModIntro.
wp_if.
wp_value; auto.
iApply wp_value; auto.
Qed.
Lemma mk_offer_works P (v : val) :
......@@ -161,7 +161,7 @@ Section side_channel.
wp_rec.
wp_alloc l as "Hl".