diff --git a/_CoqProject b/_CoqProject index 2def8bf45928256ba05e84333c694af0c032892b..eedd56c0402e561fdd1292cf9f00961a93fe947b 100644 --- a/_CoqProject +++ b/_CoqProject @@ -83,6 +83,7 @@ base_logic/lib/boxes.v base_logic/lib/thread_local.v base_logic/lib/cancelable_invariants.v base_logic/lib/counter_examples.v +base_logic/lib/fractional.v program_logic/adequacy.v program_logic/lifting.v program_logic/weakestpre.v diff --git a/base_logic/lib/cancelable_invariants.v b/base_logic/lib/cancelable_invariants.v index e4231ef1657b8cb8f710e3d278d272ff1e8e3fed..6ab787dd86551febd043f64912aee4be06ebd653 100644 --- a/base_logic/lib/cancelable_invariants.v +++ b/base_logic/lib/cancelable_invariants.v @@ -1,4 +1,4 @@ -From iris.base_logic.lib Require Export invariants. +From iris.base_logic.lib Require Export invariants fractional. From iris.algebra Require Export frac. From iris.proofmode Require Import tactics. Import uPred. @@ -31,12 +31,11 @@ Section proofs. Global Instance cinv_persistent N γ P : PersistentP (cinv N γ P). Proof. rewrite /cinv; apply _. Qed. - Lemma cinv_own_op γ q1 q2 : - cinv_own γ q1 ∗ cinv_own γ q2 ⊣⊢ cinv_own γ (q1 + q2). - Proof. by rewrite /cinv_own own_op. Qed. - - Lemma cinv_own_half γ q : cinv_own γ (q/2) ∗ cinv_own γ (q/2) ⊣⊢ cinv_own γ q. - Proof. by rewrite cinv_own_op Qp_div_2. Qed. + Global Instance cinv_own_fractionnal γ : Fractional (cinv_own γ). + Proof. intros ??. by rewrite -own_op. Qed. + Global Instance cinv_own_as_fractionnal γ q : + AsFractional (cinv_own γ q) (cinv_own γ) q. + Proof. done. Qed. Lemma cinv_own_valid γ q1 q2 : cinv_own γ q1 ∗ cinv_own γ q2 ⊢ ✓ (q1 + q2)%Qp. Proof. rewrite /cinv_own -own_op own_valid. by iIntros "% !%". Qed. @@ -56,7 +55,7 @@ Section proofs. Proof. rewrite /cinv. iIntros (?) "#Hinv Hγ". iInv N as "[$|>Hγ']" "Hclose"; first iApply "Hclose"; eauto. - iDestruct (cinv_own_1_l with "[Hγ Hγ']") as %[]. by iFrame. + iDestruct (cinv_own_1_l with "[$Hγ $Hγ']") as %[]. Qed. Lemma cinv_open E N γ p P : @@ -66,6 +65,6 @@ Section proofs. rewrite /cinv. iIntros (?) "#Hinv Hγ". iInv N as "[$|>Hγ']" "Hclose". - iIntros "!> {$Hγ} HP". iApply "Hclose"; eauto. - - iDestruct (cinv_own_1_l with "[Hγ Hγ']") as %[]. by iFrame. + - iDestruct (cinv_own_1_l with "[$Hγ $Hγ']") as %[]. Qed. End proofs. diff --git a/base_logic/lib/fractional.v b/base_logic/lib/fractional.v new file mode 100644 index 0000000000000000000000000000000000000000..a2247bf43a7f25c56832e963a4a177722fe0a834 --- /dev/null +++ b/base_logic/lib/fractional.v @@ -0,0 +1,108 @@ +From iris.base_logic Require Export derived. +From iris.proofmode Require Import classes class_instances. + +Class Fractional {M} (Φ : Qp → uPred M) := + fractional p q : Φ (p + q)%Qp ⊣⊢ Φ p ∗ Φ q. +Class AsFractional {M} (P : uPred M) (Φ : Qp → uPred M) (q : Qp) := + as_fractional : P ⊣⊢ Φ q. + +Arguments fractional {_ _ _} _ _. + +Hint Mode AsFractional - + - - : typeclass_instances. +Hint Mode AsFractional - - + + : typeclass_instances. + +Section fractional. + Context {M : ucmraT}. + Implicit Types P Q : uPred M. + Implicit Types Φ : Qp → uPred M. + Implicit Types p q : Qp. + + Lemma fractional_sep `{Fractional _ Φ} p q : + Φ (p + q)%Qp ⊢ Φ p ∗ Φ q. + Proof. by rewrite fractional. Qed. + Lemma sep_fractional `{Fractional _ Φ} p q : + Φ p ∗ Φ q ⊢ Φ (p + q)%Qp. + Proof. by rewrite fractional. Qed. + Lemma fractional_half_equiv `{Fractional _ Φ} p : + Φ p ⊣⊢ Φ (p/2)%Qp ∗ Φ (p/2)%Qp. + Proof. by rewrite -(fractional (p/2) (p/2)) Qp_div_2. Qed. + Lemma fractional_half `{Fractional _ Φ} p : + Φ p ⊢ Φ (p/2)%Qp ∗ Φ (p/2)%Qp. + Proof. by rewrite fractional_half_equiv. Qed. + Lemma half_fractional `{Fractional _ Φ} p q : + Φ (p/2)%Qp ∗ Φ (p/2)%Qp ⊢ Φ p. + Proof. by rewrite -fractional_half_equiv. Qed. + + (** Mult instances *) + + Global Instance mult_fractional_l Φ Ψ p : + (∀ q, AsFractional (Φ q) Ψ (q * p)) → Fractional Ψ → Fractional Φ. + Proof. intros AF F q q'. by rewrite !AF Qp_mult_plus_distr_l F. Qed. + Global Instance mult_fractional_r Φ Ψ p : + (∀ q, AsFractional (Φ q) Ψ (p * q)) → Fractional Ψ → Fractional Φ. + Proof. intros AF F q q'. by rewrite !AF Qp_mult_plus_distr_r F. Qed. + + (* REMARK: These two instances do not work in either direction of the + search: + - In the forward direction, they make the search not terminate + - In the backward direction, the higher order unification of Φ + with the goal does not work. *) + Instance mult_as_fractional_l P Φ p q : + AsFractional P Φ (q * p) → AsFractional P (λ q, Φ (q * p)%Qp) q. + Proof. done. Qed. + Instance mult_as_fractional_r P Φ p q : + AsFractional P Φ (p * q) → AsFractional P (λ q, Φ (p * q)%Qp) q. + Proof. done. Qed. + + (** Proof mode instances *) + + Global Instance from_sep_fractional_fwd P P1 P2 Φ q1 q2 : + AsFractional P Φ (q1 + q2) → Fractional Φ → + AsFractional P1 Φ q1 → AsFractional P2 Φ q2 → + FromSep P P1 P2. + Proof. by rewrite /FromSep=> -> -> -> ->. Qed. + Global Instance from_sep_fractional_bwd P P1 P2 Φ q1 q2 : + AsFractional P1 Φ q1 → AsFractional P2 Φ q2 → Fractional Φ → + AsFractional P Φ (q1 + q2) → + FromSep P P1 P2 | 10. + Proof. by rewrite /FromSep=> -> -> <- ->. Qed. + + Global Instance from_sep_fractional_half_fwd P Q Φ q : + AsFractional P Φ q → Fractional Φ → + AsFractional Q Φ (q/2) → + FromSep P Q Q | 10. + Proof. by rewrite /FromSep -{1}(Qp_div_2 q)=> -> -> ->. Qed. + Global Instance from_sep_fractional_half_bwd P Q Φ q : + AsFractional P Φ (q/2) → Fractional Φ → + AsFractional Q Φ q → + FromSep Q P P. + Proof. rewrite /FromSep=> -> <- ->. by rewrite Qp_div_2. Qed. + + Global Instance into_and_fractional P P1 P2 Φ q1 q2 : + AsFractional P Φ (q1 + q2) → Fractional Φ → + AsFractional P1 Φ q1 → AsFractional P2 Φ q2 → + IntoAnd false P P1 P2. + Proof. by rewrite /AsFractional /IntoAnd=>->->->->. Qed. + Global Instance into_and_fractional_half P Q Φ q : + AsFractional P Φ q → Fractional Φ → + AsFractional Q Φ (q/2) → + IntoAnd false P Q Q | 100. + Proof. by rewrite /AsFractional /IntoAnd -{1}(Qp_div_2 q)=>->->->. Qed. + + Global Instance frame_fractional_l R Q PP' QP' Φ r p p' : + AsFractional R Φ r → AsFractional PP' Φ (p + p') → Fractional Φ → + Frame R (Φ p) Q → MakeSep Q (Φ p') QP' → Frame R PP' QP'. + Proof. rewrite /Frame=>->->-><-<-. by rewrite assoc. Qed. + Global Instance frame_fractional_r R Q PP' PQ Φ r p p' : + AsFractional R Φ r → AsFractional PP' Φ (p + p') → Fractional Φ → + Frame R (Φ p') Q → MakeSep (Φ p) Q PQ → Frame R PP' PQ. + Proof. + rewrite /Frame=>->->-><-<-. rewrite !assoc. f_equiv. by rewrite comm. done. + Qed. + Global Instance frame_fractional_half P Q R Φ p: + AsFractional R Φ (p/2) → AsFractional P Φ p → Fractional Φ → + AsFractional Q Φ (p/2)%Qp → + Frame R P Q. + Proof. by rewrite /Frame -{2}(Qp_div_2 p)=>->->->->. Qed. + +End fractional. diff --git a/heap_lang/heap.v b/heap_lang/heap.v index 45b4c8b584b9b61b0902afa127babf279fcc875e..575c7b25c4ed2968046fb34c949b138391b0760f 100644 --- a/heap_lang/heap.v +++ b/heap_lang/heap.v @@ -1,7 +1,7 @@ From iris.heap_lang Require Export lifting. From iris.algebra Require Import auth gmap frac dec_agree. From iris.base_logic.lib Require Export invariants. -From iris.base_logic.lib Require Import wsat auth. +From iris.base_logic.lib Require Import wsat auth fractional. From iris.proofmode Require Import tactics. Import uPred. (* TODO: The entire construction could be generalized to arbitrary languages that have @@ -78,46 +78,34 @@ Section heap. Proof. rewrite /heap_ctx. apply _. Qed. Global Instance heap_mapsto_timeless l q v : TimelessP (l ↦{q} v). Proof. rewrite heap_mapsto_eq /heap_mapsto_def. apply _. Qed. - - Lemma heap_mapsto_op_eq l q1 q2 v : l ↦{q1} v ∗ l ↦{q2} v ⊣⊢ l ↦{q1+q2} v. + Global Instance heap_mapsto_fractional l v : Fractional (λ q, l ↦{q} v)%I. Proof. + unfold Fractional; intros. by rewrite heap_mapsto_eq -auth_own_op op_singleton pair_op dec_agree_idemp. Qed. + Global Instance heap_mapsto_as_fractional l q v : + AsFractional (l ↦{q} v) (λ q, l ↦{q} v)%I q. + Proof. done. Qed. - Lemma heap_mapsto_op l q1 q2 v1 v2 : - l ↦{q1} v1 ∗ l ↦{q2} v2 ⊣⊢ ⌜v1 = v2⌠∧ l ↦{q1+q2} v1. + Lemma heap_mapsto_agree l q1 q2 v1 v2 : + l ↦{q1} v1 ∗ l ↦{q2} v2 ⊢ ⌜v1 = v2âŒ. Proof. - destruct (decide (v1 = v2)) as [->|]. - { by rewrite heap_mapsto_op_eq pure_True // left_id. } - apply (anti_symm (⊢)); last by apply pure_elim_l. - rewrite heap_mapsto_eq -auth_own_op auth_own_valid discrete_valid. - eapply pure_elim; [done|] => /=. - rewrite op_singleton pair_op dec_agree_ne // singleton_valid. by intros []. + rewrite heap_mapsto_eq -auth_own_op auth_own_valid discrete_valid + op_singleton singleton_valid. + f_equiv. move=>[_ ] /=. + destruct (decide (v1 = v2)) as [->|?]; first done. by rewrite dec_agree_ne. Qed. - Lemma heap_mapsto_op_1 l q1 q2 v1 v2 : - l ↦{q1} v1 ∗ l ↦{q2} v2 ⊢ ⌜v1 = v2⌠∧ l ↦{q1+q2} v1. - Proof. by rewrite heap_mapsto_op. Qed. - - Lemma heap_mapsto_op_half l q v1 v2 : - l ↦{q/2} v1 ∗ l ↦{q/2} v2 ⊣⊢ ⌜v1 = v2⌠∧ l ↦{q} v1. - Proof. by rewrite heap_mapsto_op Qp_div_2. Qed. - - Lemma heap_mapsto_op_half_1 l q v1 v2 : - l ↦{q/2} v1 ∗ l ↦{q/2} v2 ⊢ ⌜v1 = v2⌠∧ l ↦{q} v1. - Proof. by rewrite heap_mapsto_op_half. Qed. - - Lemma heap_ex_mapsto_op l q1 q2 : l ↦{q1} - ∗ l ↦{q2} - ⊣⊢ l ↦{q1+q2} -. + Global Instance heap_ex_mapsto_fractional l : Fractional (λ q, l ↦{q} -)%I. Proof. - iSplit. + intros p q. iSplit. + - iDestruct 1 as (v) "[H1 H2]". iSplitL "H1"; eauto. - iIntros "[H1 H2]". iDestruct "H1" as (v1) "H1". iDestruct "H2" as (v2) "H2". - iDestruct (heap_mapsto_op_1 with "[$H1 $H2]") as "[% ?]"; subst; eauto. - - iDestruct 1 as (v) "H". rewrite -heap_mapsto_op_eq. - iDestruct "H" as "[H1 H2]"; iSplitL "H1"; eauto. + iDestruct (heap_mapsto_agree with "[$H1 $H2]") as %->. iExists v2. by iFrame. Qed. - - Lemma heap_ex_mapsto_op_half l q : l ↦{q/2} - ∗ l ↦{q/2} - ⊣⊢ l ↦{q} -. - Proof. by rewrite heap_ex_mapsto_op Qp_div_2. Qed. + Global Instance heap_ex_mapsto_as_fractional l q : + AsFractional (l ↦{q} -) (λ q, l ↦{q} -)%I q. + Proof. done. Qed. Lemma heap_mapsto_valid l q v : l ↦{q} v ⊢ ✓ q. Proof. @@ -126,7 +114,10 @@ Section heap. Qed. Lemma heap_mapsto_valid_2 l q1 q2 v1 v2 : l ↦{q1} v1 ∗ l ↦{q2} v2 ⊢ ✓ (q1 + q2)%Qp. - Proof. rewrite heap_mapsto_op heap_mapsto_valid. auto with I. Qed. + Proof. + iIntros "[H1 H2]". iDestruct (heap_mapsto_agree with "[$H1 $H2]") as %->. + iApply (heap_mapsto_valid l _ v2). by iFrame. + Qed. (** Weakest precondition *) Lemma wp_alloc E e v : diff --git a/heap_lang/proofmode.v b/heap_lang/proofmode.v index e0fba481b36dda57309490ba0a88933cc8ab127b..06d8aed0e2612bd6f6e2caf2107b3a5eed809394 100644 --- a/heap_lang/proofmode.v +++ b/heap_lang/proofmode.v @@ -12,10 +12,6 @@ Implicit Types P Q : iProp Σ. Implicit Types Φ : val → iProp Σ. Implicit Types Δ : envs (iResUR Σ). -Global Instance into_and_mapsto l q v : - IntoAnd false (l ↦{q} v) (l ↦{q/2} v) (l ↦{q/2} v). -Proof. by rewrite /IntoAnd heap_mapsto_op_eq Qp_div_2. Qed. - Lemma tac_wp_alloc Δ Δ' E j e v Φ : to_val e = Some v → (Δ ⊢ heap_ctx) → nclose heapN ⊆ E →