diff --git a/heap_lang/lang.v b/heap_lang/lang.v index 758c0dca75edbb8d33626c0628325bf97df86f8e..19c36837578967ca64a37ecd4ed3402f4d31fd4d 100644 --- a/heap_lang/lang.v +++ b/heap_lang/lang.v @@ -342,15 +342,16 @@ Inductive head_step : expr [] → state → expr [] → state → option (expr [ head_step (CAS (Loc l) e1 e2) σ (Lit $ LitBool true) (<[l:=v2]>σ) None. (** Atomic expressions *) -Definition atomic (e: expr []) : Prop := +Definition atomic (e: expr []) : bool := match e with - | Alloc e => is_Some (to_val e) - | Load e => is_Some (to_val e) - | Store e1 e2 => is_Some (to_val e1) ∧ is_Some (to_val e2) - | CAS e0 e1 e2 => is_Some (to_val e0) ∧ is_Some (to_val e1) ∧ is_Some (to_val e2) + | Alloc e => bool_decide (is_Some (to_val e)) + | Load e => bool_decide (is_Some (to_val e)) + | Store e1 e2 => bool_decide (is_Some (to_val e1) ∧ is_Some (to_val e2)) + | CAS e0 e1 e2 => + bool_decide (is_Some (to_val e0) ∧ is_Some (to_val e1) ∧ is_Some (to_val e2)) (* Make "skip" atomic *) - | App (Rec _ _ (Lit _)) (Lit _) => True - | _ => False + | App (Rec _ _ (Lit _)) (Lit _) => true + | _ => false end. (** Substitution *) @@ -449,7 +450,7 @@ Lemma val_stuck e1 σ1 e2 σ2 ef : Proof. destruct 1; naive_solver. Qed. Lemma atomic_not_val e : atomic e → to_val e = None. -Proof. destruct e; naive_solver. Qed. +Proof. by destruct e. Qed. Lemma atomic_fill_item Ki e : atomic (fill_item Ki e) → is_Some (to_val e). Proof. diff --git a/heap_lang/lifting.v b/heap_lang/lifting.v index bb651616642461a329cc29917b7c64c772bb417c..cb2701e18239741726d506a79675997c0d5b58f9 100644 --- a/heap_lang/lifting.v +++ b/heap_lang/lifting.v @@ -34,8 +34,8 @@ Proof. rewrite always_and_sep_l -assoc -always_and_sep_l. apply const_elim_l=>-[l [-> [Hl [-> ?]]]]. rewrite (forall_elim l) right_id const_equiv // left_id wand_elim_r. - rewrite -(of_to_val (Loc l) (LocV l)) // in Hl. apply of_val_inj in Hl. - by subst. + rewrite -(of_to_val (Loc l) (LocV l)) // in Hl. + by apply of_val_inj in Hl as ->. Qed. Lemma wp_load_pst E σ l v Φ : @@ -62,7 +62,7 @@ Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Φ : Proof. intros. rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool false) σ None) ?right_id //; last (by intros; inv_head_step; eauto); - simpl; split_and?; by eauto. + simpl; by eauto 10. Qed. Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Φ : @@ -72,7 +72,7 @@ Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Φ : Proof. intros. rewrite -(wp_lift_atomic_det_head_step σ (LitV $ LitBool true) (<[l:=v2]>σ) None) ?right_id //; last (by intros; inv_head_step; eauto); - simpl; split_and?; by eauto. + simpl; by eauto 10. Qed. (** Base axioms for core primitives of the language: Stateless reductions *) diff --git a/prelude/decidable.v b/prelude/decidable.v index 4dfd94a3753a8616dc321cf48bf6f3c52a303fde..819749a94b9db14aaef632d3493c16b817ce7e11 100644 --- a/prelude/decidable.v +++ b/prelude/decidable.v @@ -113,6 +113,7 @@ Lemma bool_decide_unpack (P : Prop) {dec : Decision P} : bool_decide P → P. Proof. rewrite bool_decide_spec; trivial. Qed. Lemma bool_decide_pack (P : Prop) {dec : Decision P} : P → bool_decide P. Proof. rewrite bool_decide_spec; trivial. Qed. +Hint Resolve bool_decide_pack. Lemma bool_decide_true (P : Prop) `{Decision P} : P → bool_decide P = true. Proof. case_bool_decide; tauto. Qed. Lemma bool_decide_false (P : Prop) `{Decision P} : ¬P → bool_decide P = false. diff --git a/program_logic/ectx_language.v b/program_logic/ectx_language.v index 2cae45d149b7270ae8508dfd1f035dea5350e9d3..bbb34d489979c7b38f2a6eebc04772cc611c2701 100644 --- a/program_logic/ectx_language.v +++ b/program_logic/ectx_language.v @@ -9,7 +9,7 @@ Class EctxLanguage (expr val ectx state : Type) := { empty_ectx : ectx; comp_ectx : ectx → ectx → ectx; fill : ectx → expr → expr; - atomic : expr → Prop; + atomic : expr → bool; head_step : expr → state → expr → state → option expr → Prop; to_of_val v : to_val (of_val v) = Some v; diff --git a/program_logic/language.v b/program_logic/language.v index 365841026ca463c6d18a266790c8099996d2b459..45834b1f836a7324e8c4df4dbac6d14661a46b02 100644 --- a/program_logic/language.v +++ b/program_logic/language.v @@ -6,7 +6,7 @@ Structure language := Language { state : Type; of_val : val → expr; to_val : expr → option val; - atomic : expr → Prop; + atomic : expr → bool; prim_step : expr → state → expr → state → option expr → Prop; to_of_val v : to_val (of_val v) = Some v; of_to_val e v : to_val e = Some v → of_val v = e; diff --git a/tests/one_shot.v b/tests/one_shot.v index 44325dccdc14ad5e6ff3d1b47223ddb8a38e3d8b..e87d468fa6bcee9b6e1ce17dbaa3e4b85579b455 100644 --- a/tests/one_shot.v +++ b/tests/one_shot.v @@ -57,12 +57,11 @@ Proof. rewrite !assoc 2!forall_elim; eapply wand_apply_r'; first done. rewrite (always_sep_dup (_ ★ _)); apply sep_mono. - apply forall_intro=>n. apply: always_intro. wp_let. - eapply (wp_inv_timeless _ _ _ (one_shot_inv γ l)); - rewrite /= ?to_of_val; eauto 10 with I. + eapply (wp_inv_timeless _ _ _ (one_shot_inv γ l)); eauto 10 with I. rewrite (True_intro (inv _ _)) right_id. apply wand_intro_r; rewrite sep_or_l; apply or_elim. + rewrite -wp_pvs. - wp eapply wp_cas_suc; rewrite /= ?to_of_val; eauto with I ndisj. + wp eapply wp_cas_suc; eauto with I ndisj. rewrite (True_intro (heap_ctx _)) left_id. ecancel [l ↦ _]%I; apply wand_intro_l. rewrite (own_update); (* FIXME: canonical structures are not working *) @@ -72,14 +71,13 @@ Proof. solve_sep_entails. + rewrite sep_exist_l; apply exist_elim=>m. eapply wp_cas_fail with (v':=InjRV #m) (q:=1%Qp); - rewrite /= ?to_of_val; eauto with I ndisj; strip_later. + eauto with I ndisj; strip_later. ecancel [l ↦ _]%I; apply wand_intro_l, sep_intro_True_r; eauto with I. rewrite /one_shot_inv -or_intro_r -(exist_intro m). solve_sep_entails. - apply: always_intro. wp_seq. wp_focus (Load (%l))%I. - eapply (wp_inv_timeless _ _ _ (one_shot_inv γ l)); - rewrite /= ?to_of_val; eauto 10 with I. + eapply (wp_inv_timeless _ _ _ (one_shot_inv γ l)); eauto 10 with I. apply wand_intro_r. trans (heap_ctx heapN ★ inv N (one_shot_inv γ l) ★ ∃ v, l ↦ v ★ ((v = InjLV #0 ★ own γ OneShotPending) ∨ @@ -115,8 +113,7 @@ Proof. rewrite [(w=_ ★ _)%I]comm !assoc; apply const_elim_sep_r=>->. (* FIXME: why do we need to fold? *) wp_case; fold of_val. wp_let. wp_focus (Load (%l))%I. - eapply (wp_inv_timeless _ _ _ (one_shot_inv γ l)); - rewrite /= ?to_of_val; eauto 10 with I. + eapply (wp_inv_timeless _ _ _ (one_shot_inv γ l)); eauto 10 with I. rewrite (True_intro (inv _ _)) right_id. apply wand_intro_r; rewrite sep_or_l; apply or_elim. + rewrite (True_intro (heap_ctx _)) (True_intro (l ↦ _)) !left_id.