Commit 7f8d960d by Ralf Jung

### start work on the auth construction

parent ab91a93a
 ... @@ -64,6 +64,7 @@ program_logic/resources.v ... @@ -64,6 +64,7 @@ program_logic/resources.v program_logic/hoare.v program_logic/hoare.v program_logic/language.v program_logic/language.v program_logic/tests.v program_logic/tests.v program_logic/auth.v program_logic/ghost_ownership.v program_logic/ghost_ownership.v heap_lang/heap_lang.v heap_lang/heap_lang.v heap_lang/heap_lang_tactics.v heap_lang/heap_lang_tactics.v ... ...
 ... @@ -146,6 +146,8 @@ Proof. ... @@ -146,6 +146,8 @@ Proof. Qed. Qed. Lemma auth_frag_op a b : ◯ (a ⋅ b) ≡ ◯ a ⋅ ◯ b. Lemma auth_frag_op a b : ◯ (a ⋅ b) ≡ ◯ a ⋅ ◯ b. Proof. done. Qed. Proof. done. Qed. Lemma auth_both_op a b : Auth (Excl a) b ≡ ● a ⋅ ◯ b. Proof. by rewrite /op /auth_op /= left_id. Qed. Lemma auth_update a a' b b' : Lemma auth_update a a' b b' : (∀ n af, ✓{S n} a → a ≡{S n}≡ a' ⋅ af → b ≡{S n}≡ b' ⋅ af ∧ ✓{S n} b) → (∀ n af, ✓{S n} a → a ≡{S n}≡ a' ⋅ af → b ≡{S n}≡ b' ⋅ af ∧ ✓{S n} b) → ... ...
 Require Export algebra.auth algebra.functor. Require Export algebra.auth algebra.functor. Require Import program_logic.language program_logic.weakestpre. Require Export program_logic.invariants program_logic.ghost_ownership. Import uPred. Import uPred ghost_ownership. (* RJ: This is a work-in-progress playground. FIXME: Finish or remove. *) Section auth. Section auth. (* TODO what should be implicit, what explicit? *) Context {A : cmraT} `{Empty A, !CMRAIdentity A}. Context {Λ : language}. Context {Λ : language} {Σ : gid → iFunctor} (AuthI : gid) `{!InG Λ Σ AuthI (authRA A)}. Context {C : nat → cmraT}. (* TODO: Come up with notation for "iProp Λ (globalC Σ)". *) Context (i : nat). Context (N : namespace) (φ : A → iProp Λ (globalC Σ)). Context {A : cmraT}. Implicit Types P Q R : iProp Λ (globalC Σ). Implicit Types a b : A. Hypothesis Ci : C i = authRA A. Implicit Types γ : gname. Let Σ : iFunctor := iprodF (mapF positive ∘ constF ∘ C). (* TODO: Need this to be proven somewhere. *) Definition tr (a : authRA A) : C i. (* FIXME ✓ binds too strong, I need parenthesis here. *) rewrite Ci. exact a. Defined. Hypothesis auth_valid : Definition tr' (c : C i) : authRA A. forall a b, (✓(Auth (Excl a) b) : iProp Λ (globalC Σ)) ⊑ (∃ b', a ≡ b ⋅ b'). rewrite -Ci. exact c. Defined. (* FIXME how much would break if we had a global instance from ∅ to Inhabited? *) Lemma tr'_tr a : Local Instance auth_inhabited : Inhabited A. tr' \$ tr a = a. Proof. split. exact ∅. Qed. Proof. rewrite /tr' /tr. by destruct Ci. Definition auth_inv (γ : gname) : iProp Λ (globalC Σ) := Qed. (∃ a, own AuthI γ (●a) ★ φ a)%I. Definition auth_own (γ : gname) (a : A) := own AuthI γ (◯a). Lemma tr_tr' c : Definition auth_ctx (γ : gname) := inv N (auth_inv γ). tr \$ tr' c = c. Proof. Lemma auth_alloc a : rewrite /tr' /tr. by destruct Ci. ✓a → φ a ⊑ pvs N N (∃ γ, auth_ctx γ ∧ auth_own γ a). Qed. Lemma tr_proper : Proper ((≡) ==> (≡)) tr. Proof. move=>a1 a2 Heq. rewrite /tr. by destruct Ci. Qed. Lemma Ci_op (c1 c2: C i) : c1 ⋅ c2 = tr (tr' c1 ⋅ tr' c2). Proof. rewrite /tr' /tr. by destruct Ci. Qed. Lemma A_val a : ✓a = ✓(tr a). Proof. rewrite /tr. by destruct Ci. Qed. (* FIXME RJ: I'd rather not have to specify Σ by hand here. *) Definition A2m (p : positive) (a : authRA A) : iGst Λ Σ := iprod_singleton i (<[p:=tr a]>∅). Definition ownA (p : positive) (a : authRA A) : iProp Λ Σ := ownG (Σ:=Σ) (A2m p a). Lemma ownA_op p a1 a2 : (ownA p a1 ★ ownA p a2)%I ≡ ownA p (a1 ⋅ a2). Proof. Proof. rewrite /ownA /A2m /iprod_singleton /iprod_insert -ownG_op. apply ownG_proper=>j /=. intros Ha. rewrite -(right_id True%I (★)%I (φ _)). rewrite iprod_lookup_op. destruct (decide (i = j)). rewrite (own_alloc AuthI (Auth (Excl a) a) N) //; []. - move=>q. destruct e. rewrite lookup_op /=. rewrite pvs_frame_l. apply pvs_strip_pvs. destruct (decide (p = q)); first subst q. rewrite sep_exist_l. apply exist_elim=>γ. rewrite -(exist_intro γ). + rewrite !lookup_insert. transitivity (▷auth_inv γ ★ auth_own γ a)%I. rewrite /op /cmra_op /=. f_equiv. { rewrite /auth_inv -later_intro -(exist_intro a). rewrite Ci_op. apply tr_proper. rewrite (commutative _ _ (φ _)) -associative. apply sep_mono; first done. rewrite !tr'_tr. reflexivity. rewrite /auth_own -own_op auth_both_op. done. } + by rewrite !lookup_insert_ne //. rewrite (inv_alloc N) /auth_ctx pvs_frame_r. apply pvs_mono. - by rewrite left_id. by rewrite always_and_sep_l'. Qed. Qed. (* TODO: This also holds if we just have ✓a at the current step-idx, as Iris Lemma auth_opened a γ : assertion. However, the map_updateP_alloc does not suffice to show this. *) (▷auth_inv γ ★ auth_own γ a) ⊑ (▷∃ a', φ (a ⋅ a') ★ own AuthI γ (● (a ⋅ a') ⋅ ◯ a)). Lemma ownA_alloc E a : ✓a → True ⊑ pvs E E (∃ p, ownA p a). Proof. Proof. intros Ha. set (P m := ∃ p, m = A2m p a). rewrite /auth_inv. rewrite [auth_own _ _]later_intro -later_sep. set (a' := tr a). apply later_mono. rewrite sep_exist_r. apply exist_elim=>b. rewrite -(pvs_mono _ _ (∃ m, ■P m ∧ ownG m)%I). rewrite /auth_own [(_ ★ φ _)%I]commutative -associative -own_op. - rewrite -pvs_updateP_empty //; []. rewrite own_valid_r auth_valid !sep_exist_l /=. apply exist_elim=>a'. subst P. eapply (iprod_singleton_updateP_empty i). rewrite [∅ ⋅ _]left_id -(exist_intro a'). + eapply map_updateP_alloc' with (x:=a'). subst a'. Abort. by rewrite -A_val. + simpl. move=>? [p [-> ?]]. exists p. done. - apply exist_elim=>m. apply const_elim_l. move=>[p ->] {P}. by rewrite -(exist_intro p). Qed. End auth. End auth.
 ... @@ -8,6 +8,7 @@ Local Hint Extern 100 (@subseteq coPset _ _) => solve_elem_of. ... @@ -8,6 +8,7 @@ Local Hint Extern 100 (@subseteq coPset _ _) => solve_elem_of. Local Hint Extern 100 (_ ∉ _) => solve_elem_of. Local Hint Extern 100 (_ ∉ _) => solve_elem_of. Local Hint Extern 99 ({[ _ ]} ⊆ _) => apply elem_of_subseteq_singleton. Local Hint Extern 99 ({[ _ ]} ⊆ _) => apply elem_of_subseteq_singleton. Definition namespace := list positive. Definition namespace := list positive. Definition nnil : namespace := nil. Definition nnil : namespace := nil. Definition ndot `{Countable A} (N : namespace) (x : A) : namespace := Definition ndot `{Countable A} (N : namespace) (x : A) : namespace := ... @@ -91,7 +92,7 @@ Qed. ... @@ -91,7 +92,7 @@ Qed. Lemma wp_open_close E e N P (Q : val Λ → iProp Λ Σ) : Lemma wp_open_close E e N P (Q : val Λ → iProp Λ Σ) : atomic e → nclose N ⊆ E → atomic e → nclose N ⊆ E → (inv N P ∧ (▷P -★ wp (E ∖ nclose N) e (λ v, ▷P ★ Q v)))%I ⊑ wp E e Q. (inv N P ∧ (▷P -★ wp (E ∖ nclose N) e (λ v, ▷P ★ Q v))) ⊑ wp E e Q. Proof. Proof. move=>He HN. move=>He HN. rewrite /inv and_exist_r. apply exist_elim=>i. rewrite /inv and_exist_r. apply exist_elim=>i. ... @@ -108,7 +109,7 @@ Proof. ... @@ -108,7 +109,7 @@ Proof. apply pvs_mask_frame'; solve_elem_of. apply pvs_mask_frame'; solve_elem_of. Qed. Qed. Lemma pvs_alloc N P : ▷ P ⊑ pvs N N (inv N P). Lemma inv_alloc N P : ▷ P ⊑ pvs N N (inv N P). Proof. by rewrite /inv (pvs_allocI N); last apply coPset_suffixes_infinite. Qed. Proof. by rewrite /inv (pvs_allocI N); last apply coPset_suffixes_infinite. Qed. End inv. End inv.
 ... @@ -132,6 +132,8 @@ Global Instance pvs_mono' E1 E2 : Proper ((⊑) ==> (⊑)) (@pvs Λ Σ E1 E2). ... @@ -132,6 +132,8 @@ Global Instance pvs_mono' E1 E2 : Proper ((⊑) ==> (⊑)) (@pvs Λ Σ E1 E2). Proof. intros P Q; apply pvs_mono. Qed. Proof. intros P Q; apply pvs_mono. Qed. Lemma pvs_trans' E P : pvs E E (pvs E E P) ⊑ pvs E E P. Lemma pvs_trans' E P : pvs E E (pvs E E P) ⊑ pvs E E P. Proof. apply pvs_trans; solve_elem_of. Qed. Proof. apply pvs_trans; solve_elem_of. Qed. Lemma pvs_strip_pvs E P Q : P ⊑ pvs E E Q → pvs E E P ⊑ pvs E E Q. Proof. move=>->. by rewrite pvs_trans'. Qed. Lemma pvs_frame_l E1 E2 P Q : (P ★ pvs E1 E2 Q) ⊑ pvs E1 E2 (P ★ Q). Lemma pvs_frame_l E1 E2 P Q : (P ★ pvs E1 E2 Q) ⊑ pvs E1 E2 (P ★ Q). Proof. rewrite !(commutative _ P); apply pvs_frame_r. Qed. Proof. rewrite !(commutative _ P); apply pvs_frame_r. Qed. Lemma pvs_always_l E1 E2 P Q `{!AlwaysStable P} : Lemma pvs_always_l E1 E2 P Q `{!AlwaysStable P} : ... ...
 ... @@ -100,7 +100,7 @@ Proof. ... @@ -100,7 +100,7 @@ Proof. Qed. Qed. Lemma vs_alloc (N : namespace) P : ▷ P ={N}=> inv N P. Lemma vs_alloc (N : namespace) P : ▷ P ={N}=> inv N P. Proof. by intros; apply vs_alt, pvs_alloc. Qed. Proof. by intros; apply vs_alt, inv_alloc. Qed. End vs. End vs. ... ...
 ... @@ -206,6 +206,8 @@ Proof. by apply wp_mask_frame_mono. Qed. ... @@ -206,6 +206,8 @@ Proof. by apply wp_mask_frame_mono. Qed. Global Instance wp_mono' E e : Global Instance wp_mono' E e : Proper (pointwise_relation _ (⊑) ==> (⊑)) (@wp Λ Σ E e). Proper (pointwise_relation _ (⊑) ==> (⊑)) (@wp Λ Σ E e). Proof. by intros Q Q' ?; apply wp_mono. Qed. Proof. by intros Q Q' ?; apply wp_mono. Qed. Lemma wp_strip_pvs E e P Q : P ⊑ wp E e Q → pvs E E P ⊑ wp E e Q. Proof. move=>->. by rewrite pvs_wp. Qed. Lemma wp_value' E Q e v : to_val e = Some v → Q v ⊑ wp E e Q. Lemma wp_value' E Q e v : to_val e = Some v → Q v ⊑ wp E e Q. Proof. intros; rewrite -(of_to_val e v) //; by apply wp_value. Qed. Proof. intros; rewrite -(of_to_val e v) //; by apply wp_value. Qed. Lemma wp_frame_l E e Q R : (R ★ wp E e Q) ⊑ wp E e (λ v, R ★ Q v). Lemma wp_frame_l E e Q R : (R ★ wp E e Q) ⊑ wp E e (λ v, R ★ Q v). ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!