Commit ffa92c50 by Robbert Krebbers

### Introduce notation || e @ E {{ Φ }} for weakest pre.

parent 01eb6f6a
 ... @@ -146,7 +146,7 @@ Section proof. ... @@ -146,7 +146,7 @@ Section proof. Lemma newchan_spec (P : iProp) (Φ : val → iProp) : Lemma newchan_spec (P : iProp) (Φ : val → iProp) : (heap_ctx heapN ★ ∀ l, recv l P ★ send l P -★ Φ (LocV l)) (heap_ctx heapN ★ ∀ l, recv l P ★ send l P -★ Φ (LocV l)) ⊑ wp ⊤ (newchan '()) Φ. ⊑ || newchan '() {{ Φ }}. Proof. Proof. rewrite /newchan. wp_rec. (* TODO: wp_seq. *) rewrite /newchan. wp_rec. (* TODO: wp_seq. *) rewrite -wp_pvs. wp> eapply wp_alloc; eauto with I ndisj. rewrite -wp_pvs. wp> eapply wp_alloc; eauto with I ndisj. ... @@ -196,7 +196,7 @@ Section proof. ... @@ -196,7 +196,7 @@ Section proof. Qed. Qed. Lemma signal_spec l P (Φ : val → iProp) : Lemma signal_spec l P (Φ : val → iProp) : heapN ⊥ N → (send l P ★ P ★ Φ '()) ⊑ wp ⊤ (signal (LocV l)) Φ. heapN ⊥ N → (send l P ★ P ★ Φ '()) ⊑ || signal (LocV l) {{ Φ }}. Proof. Proof. intros Hdisj. rewrite /signal /send /barrier_ctx. rewrite sep_exist_r. intros Hdisj. rewrite /signal /send /barrier_ctx. rewrite sep_exist_r. apply exist_elim=>γ. wp_rec. (* FIXME wp_let *) apply exist_elim=>γ. wp_rec. (* FIXME wp_let *) ... @@ -226,12 +226,12 @@ Section proof. ... @@ -226,12 +226,12 @@ Section proof. Qed. Qed. Lemma wait_spec l P (Φ : val → iProp) : Lemma wait_spec l P (Φ : val → iProp) : heapN ⊥ N → (recv l P ★ (P -★ Φ '())) ⊑ wp ⊤ (wait (LocV l)) Φ. heapN ⊥ N → (recv l P ★ (P -★ Φ '())) ⊑ || wait (LocV l) {{ Φ }}. Proof. Proof. Abort. Abort. Lemma split_spec l P1 P2 Φ : Lemma split_spec l P1 P2 Φ : (recv l (P1 ★ P2) ★ (recv l P1 ★ recv l P2 -★ Φ '())) ⊑ wp ⊤ Skip Φ. (recv l (P1 ★ P2) ★ (recv l P1 ★ recv l P2 -★ Φ '())) ⊑ || Skip {{ Φ }}. Proof. Proof. Abort. Abort. ... ...
 ... @@ -17,44 +17,47 @@ Implicit Types Φ : val → iProp heap_lang Σ. ... @@ -17,44 +17,47 @@ Implicit Types Φ : val → iProp heap_lang Σ. (** Proof rules for the sugar *) (** Proof rules for the sugar *) Lemma wp_lam' E x ef e v Φ : Lemma wp_lam' E x ef e v Φ : to_val e = Some v → ▷ wp E (subst ef x v) Φ ⊑ wp E (App (Lam x ef) e) Φ. to_val e = Some v → ▷ || subst ef x v @ E {{ Φ }} ⊑ || App (Lam x ef) e @ E {{ Φ }}. Proof. intros. by rewrite -wp_rec' ?subst_empty. Qed. Proof. intros. by rewrite -wp_rec' ?subst_empty. Qed. Lemma wp_let' E x e1 e2 v Φ : Lemma wp_let' E x e1 e2 v Φ : to_val e1 = Some v → ▷ wp E (subst e2 x v) Φ ⊑ wp E (Let x e1 e2) Φ. to_val e1 = Some v → ▷ || subst e2 x v @ E {{ Φ }} ⊑ || Let x e1 e2 @ E {{ Φ }}. Proof. apply wp_lam'. Qed. Proof. apply wp_lam'. Qed. Lemma wp_seq E e1 e2 Φ : wp E e1 (λ _, ▷ wp E e2 Φ) ⊑ wp E (Seq e1 e2) Φ. Lemma wp_seq E e1 e2 Φ : || e1 @ E {{ λ _, ▷ || e2 @ E {{ Φ }} }} ⊑ || Seq e1 e2 @ E {{ Φ }}. Proof. Proof. rewrite -(wp_bind [LetCtx "" e2]). apply wp_mono=>v. rewrite -(wp_bind [LetCtx "" e2]). apply wp_mono=>v. by rewrite -wp_let' //= ?to_of_val ?subst_empty. by rewrite -wp_let' //= ?to_of_val ?subst_empty. Qed. Qed. Lemma wp_skip E Φ : ▷ (Φ (LitV LitUnit)) ⊑ wp E Skip Φ. Lemma wp_skip E Φ : ▷ Φ (LitV LitUnit) ⊑ || Skip @ E {{ Φ }}. Proof. rewrite -wp_seq -wp_value // -wp_value //. Qed. Proof. rewrite -wp_seq -wp_value // -wp_value //. Qed. Lemma wp_le E (n1 n2 : Z) P Φ : Lemma wp_le E (n1 n2 : Z) P Φ : (n1 ≤ n2 → P ⊑ ▷ Φ (LitV \$ LitBool true)) → (n1 ≤ n2 → P ⊑ ▷ Φ (LitV (LitBool true))) → (n2 < n1 → P ⊑ ▷ Φ (LitV \$ LitBool false)) → (n2 < n1 → P ⊑ ▷ Φ (LitV (LitBool false))) → P ⊑ wp E (BinOp LeOp (Lit \$ LitInt n1) (Lit \$ LitInt n2)) Φ. P ⊑ || BinOp LeOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}. Proof. Proof. intros. rewrite -wp_bin_op //; []. intros. rewrite -wp_bin_op //; []. destruct (bool_decide_reflect (n1 ≤ n2)); by eauto with omega. destruct (bool_decide_reflect (n1 ≤ n2)); by eauto with omega. Qed. Qed. Lemma wp_lt E (n1 n2 : Z) P Φ : Lemma wp_lt E (n1 n2 : Z) P Φ : (n1 < n2 → P ⊑ ▷ Φ (LitV \$ LitBool true)) → (n1 < n2 → P ⊑ ▷ Φ (LitV (LitBool true))) → (n2 ≤ n1 → P ⊑ ▷ Φ (LitV \$ LitBool false)) → (n2 ≤ n1 → P ⊑ ▷ Φ (LitV (LitBool false))) → P ⊑ wp E (BinOp LtOp (Lit \$ LitInt n1) (Lit \$ LitInt n2)) Φ. P ⊑ || BinOp LtOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}. Proof. Proof. intros. rewrite -wp_bin_op //; []. intros. rewrite -wp_bin_op //; []. destruct (bool_decide_reflect (n1 < n2)); by eauto with omega. destruct (bool_decide_reflect (n1 < n2)); by eauto with omega. Qed. Qed. Lemma wp_eq E (n1 n2 : Z) P Φ : Lemma wp_eq E (n1 n2 : Z) P Φ : (n1 = n2 → P ⊑ ▷ Φ (LitV \$ LitBool true)) → (n1 = n2 → P ⊑ ▷ Φ (LitV (LitBool true))) → (n1 ≠ n2 → P ⊑ ▷ Φ (LitV \$ LitBool false)) → (n1 ≠ n2 → P ⊑ ▷ Φ (LitV (LitBool false))) → P ⊑ wp E (BinOp EqOp (Lit \$ LitInt n1) (Lit \$ LitInt n2)) Φ. P ⊑ || BinOp EqOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}. Proof. Proof. intros. rewrite -wp_bin_op //; []. intros. rewrite -wp_bin_op //; []. destruct (bool_decide_reflect (n1 = n2)); by eauto with omega. destruct (bool_decide_reflect (n1 = n2)); by eauto with omega. ... ...
 ... @@ -65,7 +65,7 @@ Section heap. ... @@ -65,7 +65,7 @@ Section heap. (** Allocation *) (** Allocation *) Lemma heap_alloc E N σ : Lemma heap_alloc E N σ : authG heap_lang Σ heapRA → nclose N ⊆ E → authG heap_lang Σ heapRA → nclose N ⊆ E → ownP σ ⊑ (|={E}=> ∃ (_ : heapG Σ), heap_ctx N ∧ Π★{map σ} heap_mapsto). ownP σ ⊑ (|={E}=> ∃ _ : heapG Σ, heap_ctx N ∧ Π★{map σ} heap_mapsto). Proof. Proof. intros. rewrite -{1}(from_to_heap σ). etransitivity. intros. rewrite -{1}(from_to_heap σ). etransitivity. { rewrite [ownP _]later_intro. { rewrite [ownP _]later_intro. ... @@ -100,7 +100,7 @@ Section heap. ... @@ -100,7 +100,7 @@ Section heap. to_val e = Some v → nclose N ⊆ E → to_val e = Some v → nclose N ⊆ E → P ⊑ heap_ctx N → P ⊑ heap_ctx N → P ⊑ (▷ ∀ l, l ↦ v -★ Φ (LocV l)) → P ⊑ (▷ ∀ l, l ↦ v -★ Φ (LocV l)) → P ⊑ wp E (Alloc e) Φ. P ⊑ || Alloc e @ E {{ Φ }}. Proof. Proof. rewrite /heap_ctx /heap_inv /heap_mapsto=> ?? Hctx HP. rewrite /heap_ctx /heap_inv /heap_mapsto=> ?? Hctx HP. transitivity (|={E}=> auth_own heap_name ∅ ★ P)%I. transitivity (|={E}=> auth_own heap_name ∅ ★ P)%I. ... @@ -127,7 +127,7 @@ Section heap. ... @@ -127,7 +127,7 @@ Section heap. nclose N ⊆ E → nclose N ⊆ E → P ⊑ heap_ctx N → P ⊑ heap_ctx N → P ⊑ (▷ l ↦ v ★ ▷ (l ↦ v -★ Φ v)) → P ⊑ (▷ l ↦ v ★ ▷ (l ↦ v -★ Φ v)) → P ⊑ wp E (Load (Loc l)) Φ. P ⊑ || Load (Loc l) @ E {{ Φ }}. Proof. Proof. rewrite /heap_ctx /heap_inv /heap_mapsto=>HN ? HPΦ. rewrite /heap_ctx /heap_inv /heap_mapsto=>HN ? HPΦ. apply (auth_fsa' heap_inv (wp_fsa _) id) apply (auth_fsa' heap_inv (wp_fsa _) id) ... @@ -146,7 +146,7 @@ Section heap. ... @@ -146,7 +146,7 @@ Section heap. to_val e = Some v → nclose N ⊆ E → to_val e = Some v → nclose N ⊆ E → P ⊑ heap_ctx N → P ⊑ heap_ctx N → P ⊑ (▷ l ↦ v' ★ ▷ (l ↦ v -★ Φ (LitV LitUnit))) → P ⊑ (▷ l ↦ v' ★ ▷ (l ↦ v -★ Φ (LitV LitUnit))) → P ⊑ wp E (Store (Loc l) e) Φ. P ⊑ || Store (Loc l) e @ E {{ Φ }}. Proof. Proof. rewrite /heap_ctx /heap_inv /heap_mapsto=>? HN ? HPΦ. rewrite /heap_ctx /heap_inv /heap_mapsto=>? HN ? HPΦ. apply (auth_fsa' heap_inv (wp_fsa _) (alter (λ _, Excl v) l)) apply (auth_fsa' heap_inv (wp_fsa _) (alter (λ _, Excl v) l)) ... @@ -167,7 +167,7 @@ Section heap. ... @@ -167,7 +167,7 @@ Section heap. nclose N ⊆ E → nclose N ⊆ E → P ⊑ heap_ctx N → P ⊑ heap_ctx N → P ⊑ (▷ l ↦ v' ★ ▷ (l ↦ v' -★ Φ (LitV (LitBool false)))) → P ⊑ (▷ l ↦ v' ★ ▷ (l ↦ v' -★ Φ (LitV (LitBool false)))) → P ⊑ wp E (Cas (Loc l) e1 e2) Φ. P ⊑ || Cas (Loc l) e1 e2 @ E {{ Φ }}. Proof. Proof. rewrite /heap_ctx /heap_inv /heap_mapsto=>??? HN ? HPΦ. rewrite /heap_ctx /heap_inv /heap_mapsto=>??? HN ? HPΦ. apply (auth_fsa' heap_inv (wp_fsa _) id) apply (auth_fsa' heap_inv (wp_fsa _) id) ... @@ -187,7 +187,7 @@ Section heap. ... @@ -187,7 +187,7 @@ Section heap. nclose N ⊆ E → nclose N ⊆ E → P ⊑ heap_ctx N → P ⊑ heap_ctx N → P ⊑ (▷ l ↦ v1 ★ ▷ (l ↦ v2 -★ Φ (LitV (LitBool true)))) → P ⊑ (▷ l ↦ v1 ★ ▷ (l ↦ v2 -★ Φ (LitV (LitBool true)))) → P ⊑ wp E (Cas (Loc l) e1 e2) Φ. P ⊑ || Cas (Loc l) e1 e2 @ E {{ Φ }}. Proof. Proof. rewrite /heap_ctx /heap_inv /heap_mapsto=> ?? HN ? HPΦ. rewrite /heap_ctx /heap_inv /heap_mapsto=> ?? HN ? HPΦ. apply (auth_fsa' heap_inv (wp_fsa _) (alter (λ _, Excl v2) l)) apply (auth_fsa' heap_inv (wp_fsa _) (alter (λ _, Excl v2) l)) ... ...
 ... @@ -16,18 +16,14 @@ Implicit Types ef : option expr. ... @@ -16,18 +16,14 @@ Implicit Types ef : option expr. (** Bind. *) (** Bind. *) Lemma wp_bind {E e} K Φ : Lemma wp_bind {E e} K Φ : wp E e (λ v, wp E (fill K (of_val v)) Φ) ⊑ wp E (fill K e) Φ. || e @ E {{ λ v, || fill K (of_val v) @ E {{ Φ }}}} ⊑ || fill K e @ E {{ Φ }}. Proof. apply weakestpre.wp_bind. Qed. Lemma wp_bindi {E e} Ki Φ : wp E e (λ v, wp E (fill_item Ki (of_val v)) Φ) ⊑ wp E (fill_item Ki e) Φ. Proof. apply weakestpre.wp_bind. Qed. Proof. apply weakestpre.wp_bind. Qed. (** Base axioms for core primitives of the language: Stateful reductions. *) (** Base axioms for core primitives of the language: Stateful reductions. *) Lemma wp_alloc_pst E σ e v Φ : Lemma wp_alloc_pst E σ e v Φ : to_val e = Some v → to_val e = Some v → (ownP σ ★ ▷ (∀ l, σ !! l = None ∧ ownP (<[l:=v]>σ) -★ Φ (LocV l))) (ownP σ ★ ▷ (∀ l, σ !! l = None ∧ ownP (<[l:=v]>σ) -★ Φ (LocV l))) ⊑ wp E (Alloc e) Φ. ⊑ || Alloc e @ E {{ Φ }}. Proof. Proof. (* TODO RJ: This works around ssreflect bug #22. *) (* TODO RJ: This works around ssreflect bug #22. *) intros. set (φ v' σ' ef := ∃ l, intros. set (φ v' σ' ef := ∃ l, ... @@ -44,7 +40,7 @@ Qed. ... @@ -44,7 +40,7 @@ Qed. Lemma wp_load_pst E σ l v Φ : Lemma wp_load_pst E σ l v Φ : σ !! l = Some v → σ !! l = Some v → (ownP σ ★ ▷ (ownP σ -★ Φ v)) ⊑ wp E (Load (Loc l)) Φ. (ownP σ ★ ▷ (ownP σ -★ Φ v)) ⊑ || Load (Loc l) @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_atomic_det_step σ v σ None) ?right_id //; intros. rewrite -(wp_lift_atomic_det_step σ v σ None) ?right_id //; last by intros; inv_step; eauto using to_of_val. last by intros; inv_step; eauto using to_of_val. ... @@ -52,7 +48,8 @@ Qed. ... @@ -52,7 +48,8 @@ Qed. Lemma wp_store_pst E σ l e v v' Φ : Lemma wp_store_pst E σ l e v v' Φ : to_val e = Some v → σ !! l = Some v' → to_val e = Some v → σ !! l = Some v' → (ownP σ ★ ▷ (ownP (<[l:=v]>σ) -★ Φ (LitV LitUnit))) ⊑ wp E (Store (Loc l) e) Φ. (ownP σ ★ ▷ (ownP (<[l:=v]>σ) -★ Φ (LitV LitUnit))) ⊑ || Store (Loc l) e @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_atomic_det_step σ (LitV LitUnit) (<[l:=v]>σ) None) intros. rewrite -(wp_lift_atomic_det_step σ (LitV LitUnit) (<[l:=v]>σ) None) ?right_id //; last by intros; inv_step; eauto. ?right_id //; last by intros; inv_step; eauto. ... @@ -60,7 +57,8 @@ Qed. ... @@ -60,7 +57,8 @@ Qed. Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Φ : Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Φ : to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v' → v' ≠ v1 → to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v' → v' ≠ v1 → (ownP σ ★ ▷ (ownP σ -★ Φ (LitV \$ LitBool false))) ⊑ wp E (Cas (Loc l) e1 e2) Φ. (ownP σ ★ ▷ (ownP σ -★ Φ (LitV \$ LitBool false))) ⊑ || Cas (Loc l) e1 e2 @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_atomic_det_step σ (LitV \$ LitBool false) σ None) intros. rewrite -(wp_lift_atomic_det_step σ (LitV \$ LitBool false) σ None) ?right_id //; last by intros; inv_step; eauto. ?right_id //; last by intros; inv_step; eauto. ... @@ -69,15 +67,15 @@ Qed. ... @@ -69,15 +67,15 @@ Qed. Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Φ : Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Φ : to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v1 → to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v1 → (ownP σ ★ ▷ (ownP (<[l:=v2]>σ) -★ Φ (LitV \$ LitBool true))) (ownP σ ★ ▷ (ownP (<[l:=v2]>σ) -★ Φ (LitV \$ LitBool true))) ⊑ wp E (Cas (Loc l) e1 e2) Φ. ⊑ || Cas (Loc l) e1 e2 @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_atomic_det_step σ (LitV \$ LitBool true) (<[l:=v2]>σ) None) intros. rewrite -(wp_lift_atomic_det_step σ (LitV \$ LitBool true) ?right_id //; last by intros; inv_step; eauto. (<[l:=v2]>σ) None) ?right_id //; last by intros; inv_step; eauto. Qed. Qed. (** Base axioms for core primitives of the language: Stateless reductions *) (** Base axioms for core primitives of the language: Stateless reductions *) Lemma wp_fork E e Φ : Lemma wp_fork E e Φ : (▷ Φ (LitV LitUnit) ★ ▷ wp (Σ:=Σ) ⊤ e (λ _, True)) ⊑ wp E (Fork e) Φ. (▷ Φ (LitV LitUnit) ★ ▷ || e {{ λ _, True }}) ⊑ || Fork e @ E {{ Φ }}. Proof. Proof. rewrite -(wp_lift_pure_det_step (Fork e) (Lit LitUnit) (Some e)) //=; rewrite -(wp_lift_pure_det_step (Fork e) (Lit LitUnit) (Some e)) //=; last by intros; inv_step; eauto. last by intros; inv_step; eauto. ... @@ -88,7 +86,8 @@ Qed. ... @@ -88,7 +86,8 @@ Qed. The final version is defined in substitution.v. *) The final version is defined in substitution.v. *) Lemma wp_rec' E f x e1 e2 v Φ : Lemma wp_rec' E f x e1 e2 v Φ : to_val e2 = Some v → to_val e2 = Some v → ▷ wp E (subst (subst e1 f (RecV f x e1)) x v) Φ ⊑ wp E (App (Rec f x e1) e2) Φ. ▷ || subst (subst e1 f (RecV f x e1)) x v @ E {{ Φ }} ⊑ || App (Rec f x e1) e2 @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_pure_det_step (App _ _) intros. rewrite -(wp_lift_pure_det_step (App _ _) (subst (subst e1 f (RecV f x e1)) x v) None) ?right_id //=; (subst (subst e1 f (RecV f x e1)) x v) None) ?right_id //=; ... @@ -97,7 +96,7 @@ Qed. ... @@ -97,7 +96,7 @@ Qed. Lemma wp_un_op E op l l' Φ : Lemma wp_un_op E op l l' Φ : un_op_eval op l = Some l' → un_op_eval op l = Some l' → ▷ Φ (LitV l') ⊑ wp E (UnOp op (Lit l)) Φ. ▷ Φ (LitV l') ⊑ || UnOp op (Lit l) @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_pure_det_step (UnOp op _) (Lit l') None) intros. rewrite -(wp_lift_pure_det_step (UnOp op _) (Lit l') None) ?right_id -?wp_value //; intros; inv_step; eauto. ?right_id -?wp_value //; intros; inv_step; eauto. ... @@ -105,21 +104,21 @@ Qed. ... @@ -105,21 +104,21 @@ Qed. Lemma wp_bin_op E op l1 l2 l' Φ : Lemma wp_bin_op E op l1 l2 l' Φ : bin_op_eval op l1 l2 = Some l' → bin_op_eval op l1 l2 = Some l' → ▷ Φ (LitV l') ⊑ wp E (BinOp op (Lit l1) (Lit l2)) Φ. ▷ Φ (LitV l') ⊑ || BinOp op (Lit l1) (Lit l2) @ E {{ Φ }}. Proof. Proof. intros Heval. rewrite -(wp_lift_pure_det_step (BinOp op _ _) (Lit l') None) intros Heval. rewrite -(wp_lift_pure_det_step (BinOp op _ _) (Lit l') None) ?right_id -?wp_value //; intros; inv_step; eauto. ?right_id -?wp_value //; intros; inv_step; eauto. Qed. Qed. Lemma wp_if_true E e1 e2 Φ : Lemma wp_if_true E e1 e2 Φ : ▷ wp E e1 Φ ⊑ wp E (If (Lit \$ LitBool true) e1 e2) Φ. ▷ || e1 @ E {{ Φ }} ⊑ || If (Lit (LitBool true)) e1 e2 @ E {{ Φ }}. Proof. Proof. rewrite -(wp_lift_pure_det_step (If _ _ _) e1 None) rewrite -(wp_lift_pure_det_step (If _ _ _) e1 None) ?right_id //; intros; inv_step; eauto. ?right_id //; intros; inv_step; eauto. Qed. Qed. Lemma wp_if_false E e1 e2 Φ : Lemma wp_if_false E e1 e2 Φ : ▷ wp E e2 Φ ⊑ wp E (If (Lit \$ LitBool false) e1 e2) Φ. ▷ || e2 @ E {{ Φ }} ⊑ || If (Lit (LitBool false)) e1 e2 @ E {{ Φ }}. Proof. Proof. rewrite -(wp_lift_pure_det_step (If _ _ _) e2 None) rewrite -(wp_lift_pure_det_step (If _ _ _) e2 None) ?right_id //; intros; inv_step; eauto. ?right_id //; intros; inv_step; eauto. ... @@ -127,7 +126,7 @@ Qed. ... @@ -127,7 +126,7 @@ Qed. Lemma wp_fst E e1 v1 e2 v2 Φ : Lemma wp_fst E e1 v1 e2 v2 Φ : to_val e1 = Some v1 → to_val e2 = Some v2 → to_val e1 = Some v1 → to_val e2 = Some v2 → ▷ Φ v1 ⊑ wp E (Fst \$ Pair e1 e2) Φ. ▷ Φ v1 ⊑ || Fst (Pair e1 e2) @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_pure_det_step (Fst _) e1 None) intros. rewrite -(wp_lift_pure_det_step (Fst _) e1 None) ?right_id -?wp_value //; intros; inv_step; eauto. ?right_id -?wp_value //; intros; inv_step; eauto. ... @@ -135,7 +134,7 @@ Qed. ... @@ -135,7 +134,7 @@ Qed. Lemma wp_snd E e1 v1 e2 v2 Φ : Lemma wp_snd E e1 v1 e2 v2 Φ : to_val e1 = Some v1 → to_val e2 = Some v2 → to_val e1 = Some v1 → to_val e2 = Some v2 → ▷ Φ v2 ⊑ wp E (Snd \$ Pair e1 e2) Φ. ▷ Φ v2 ⊑ || Snd (Pair e1 e2) @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_pure_det_step (Snd _) e2 None) intros. rewrite -(wp_lift_pure_det_step (Snd _) e2 None) ?right_id -?wp_value //; intros; inv_step; eauto. ?right_id -?wp_value //; intros; inv_step; eauto. ... @@ -143,7 +142,7 @@ Qed. ... @@ -143,7 +142,7 @@ Qed. Lemma wp_case_inl' E e0 v0 x1 e1 x2 e2 Φ : Lemma wp_case_inl' E e0 v0 x1 e1 x2 e2 Φ : to_val e0 = Some v0 → to_val e0 = Some v0 → ▷ wp E (subst e1 x1 v0) Φ ⊑ wp E (Case (InjL e0) x1 e1 x2 e2) Φ. ▷ || subst e1 x1 v0 @ E {{ Φ }} ⊑ || Case (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_pure_det_step (Case _ _ _ _ _) intros. rewrite -(wp_lift_pure_det_step (Case _ _ _ _ _) (subst e1 x1 v0) None) ?right_id //; intros; inv_step; eauto. (subst e1 x1 v0) None) ?right_id //; intros; inv_step; eauto. ... @@ -151,7 +150,7 @@ Qed. ... @@ -151,7 +150,7 @@ Qed. Lemma wp_case_inr' E e0 v0 x1 e1 x2 e2 Φ : Lemma wp_case_inr' E e0 v0 x1 e1 x2 e2 Φ : to_val e0 = Some v0 → to_val e0 = Some v0 → ▷ wp E (subst e2 x2 v0) Φ ⊑ wp E (Case (InjR e0) x1 e1 x2 e2) Φ. ▷ || subst e2 x2 v0 @ E {{ Φ }} ⊑ || Case (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}. Proof. Proof. intros. rewrite -(wp_lift_pure_det_step (Case _ _ _ _ _) intros. rewrite -(wp_lift_pure_det_step (Case _ _ _ _ _) (subst e2 x2 v0) None) ?right_id //; intros; inv_step; eauto. (subst e2 x2 v0) None) ?right_id //; intros; inv_step; eauto. ... ...
 From heap_lang Require Export derived. From heap_lang Require Export derived. (* What about Arguments for hoare triples?. *) Arguments wp {_ _} _ _%L _. Arguments wp {_ _} _ _%L _. Notation "|| e @ E {{ Φ } }" := (wp E e%L Φ) (at level 20, e, Φ at level 200, format "|| e @ E {{ Φ } }") : uPred_scope. Notation "|| e {{ Φ } }" := (wp ⊤ e%L Φ) (at level 20, e, Φ at level 200, format "|| e {{ Φ } }") : uPred_scope. Coercion LitInt : Z >-> base_lit. Coercion LitInt : Z >-> base_lit. Coercion LitBool : bool >-> base_lit. Coercion LitBool : bool >-> base_lit. ... ...
 ... @@ -26,10 +26,10 @@ to be unfolded. For example, consider the rule [wp_rec'] from below: ... @@ -26,10 +26,10 @@ to be unfolded. For example, consider the rule [wp_rec'] from below: << << Definition foo : val := rec: "f" "x" := ... . Definition foo : val := rec: "f" "x" := ... . Lemma wp_rec' E e1 f x erec e2 v Q : Lemma wp_rec E e1 f x erec e2 v Φ : e1 = Rec f x erec → e1 = Rec f x erec → to_val e2 = Some v → to_val e2 = Some v → ▷ wp E (gsubst (gsubst erec f e1) x e2) Q ⊑ wp E (App e1 e2) Q. ▷ || gsubst (gsubst erec f e1) x e2 @ E {{ Φ }} ⊑ || App e1 e2 @ E {{ Φ }}. >> >> We ensure that [e1] is substituted instead of [RecV f x erec]. So, for example We ensure that [e1] is substituted instead of [RecV f x erec]. So, for example ... @@ -123,7 +123,7 @@ Hint Resolve to_of_val. ... @@ -123,7 +123,7 @@ Hint Resolve to_of_val. Lemma wp_rec E e1 f x erec e2 v Φ : Lemma wp_rec E e1 f x erec e2 v Φ : e1 = Rec f x erec → e1 = Rec f x erec → to_val e2 = Some v → to_val e2 = Some v → ▷ wp E (gsubst (gsubst erec f e1) x e2) Φ ⊑ wp E (App e1 e2) Φ. ▷ || gsubst (gsubst erec f e1) x e2 @ E {{ Φ }} ⊑ || App e1 e2 @ E {{ Φ }}. Proof. Proof. intros -> <-%of_to_val. intros -> <-%of_to_val. rewrite (gsubst_correct _ _ (RecV _ _ _)) gsubst_correct. rewrite (gsubst_correct _ _ (RecV _ _ _)) gsubst_correct. ... @@ -131,21 +131,22 @@ Proof. ... @@ -131,21 +131,22 @@ Proof. Qed. Qed. Lemma wp_lam E x ef e v Φ : Lemma wp_lam E x ef e v Φ : to_val e = Some v → ▷ wp E (gsubst ef x e) Φ ⊑ wp E (App (Lam x ef) e) Φ. to_val e = Some v → ▷ || gsubst ef x e @ E {{ Φ }} ⊑ || App (Lam x ef) e @ E {{ Φ }}. Proof. intros <-%of_to_val; rewrite gsubst_correct. by apply wp_lam'. Qed. Proof. intros <-%of_to_val; rewrite gsubst_correct. by apply wp_lam'. Qed. Lemma wp_let E x e1 e2 v Φ : Lemma wp_let E x e1 e2 v Φ : to_val e1 = Some v → ▷ wp E (gsubst e2 x e1) Φ ⊑ wp E (Let x e1 e2) Φ. to_val e1 = Some v → ▷ || gsubst e2 x e1 @ E {{ Φ }} ⊑ || Let x e1 e2 @ E {{ Φ }}. Proof. apply wp_lam. Qed. Proof. apply wp_lam. Qed. Lemma wp_case_inl E e0 v0 x1 e1 x2 e2 Φ : Lemma wp_case_inl E e0 v0 x1 e1 x2 e2 Φ :