RunST.ICTriple
From RunST Require Export IC.
From iris.base_logic.lib Require Export viewshifts.
From iris.proofmode Require Import tactics.
Definition ict `{ICState Λ, ICG Λ Σ} γ (E : coPset) (P : iProp Σ)
(e : expr Λ) (Φ : val Λ → nat → iProp Σ) : iProp Σ :=
(□ (P -★ IC e @ E {{ Φ }}[γ]))%I.
Instance: Params (@ict) 5.
Notation "{{| P |} } e @ E {{| Φ |} }[ γ ]" := (ict γ E P e%E Φ)
(at level 20, P, e, Φ at level 200,
format "{{| P |} } e @ E {{| Φ |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e {{| Φ |} }[ γ ]" := (ict γ ⊤ P e%E Φ)
(at level 20, P, e, Φ at level 200,
format "{{| P |} } e {{| Φ |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e @ E {{| Φ |} }[ γ ]" := (True ⊢ ict γ E P e%E Φ)
(at level 20, P, e, Φ at level 200,
format "{{| P |} } e @ E {{| Φ |} }[ γ ]") : C_scope.
Notation "{{| P |} } e {{| Φ |} }[ γ ]" := (True ⊢ ict γ ⊤ P e%E Φ)
(at level 20, P, e, Φ at level 200,
format "{{| P |} } e {{| Φ |} }[ γ ]") : C_scope.
Notation "{{| P |} } e @ E {{| v ; n , Q |} }[ γ ]" := (ict γ E P e%E (λ v n, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e @ E {{| v ; n , Q |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e @ E {{| v , Q |} }[ γ ]" := (ict γ E P e%E (λ v _, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e @ E {{| v , Q |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e {{| v ; n , Q |} }[ γ ]" := (ict γ ⊤ P e%E (λ v n, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e {{| v ; n , Q |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e {{| v , Q |} }[ γ ]" := (ict γ ⊤ P e%E (λ v _, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e {{| v , Q |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e @ E {{| v ; n , Q |} }[ γ ]" := (True ⊢ ict γ E P e%E (λ v n, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e @ E {{| v ; n , Q |} }[ γ ]") : C_scope.
Notation "{{| P |} } e @ E {{| v , Q |} }[ γ ]" := (True ⊢ ict γ E P e%E (λ v _, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e @ E {{| v , Q |} }[ γ ]") : C_scope.
Notation "{{| P |} } e {{| v ; n , Q |} }[ γ ]" := (True ⊢ ict γ ⊤ P e%E (λ v n, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e {{| v ; n , Q |} }[ γ ]") : C_scope.
Notation "{{| P |} } e {{| v , Q |} }[ γ ]" := (True ⊢ ict γ ⊤ P e%E (λ v _, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e {{| v , Q |} }[ γ ]") : C_scope.
Section hoare.
Context `{ICState Λ, ICG Λ Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ Ψ : val Λ → nat → iProp Σ.
Implicit Types v : val Λ.
Import uPred.
Global Instance ict_ne γ E n :
Proper (dist n ==> eq==>pointwise_relation _ ((dist n) ==> (dist n)) ==> dist n)
(ict γ E).
Proof. unfold ict; solve_proper. Qed.
Global Instance ict_proper γ E :
Proper ((≡) ==> eq ==> pointwise_relation _ ((≡) ==> (≡)) ==> (≡)) (ict γ E).
Proof. unfold ict; solve_proper. Qed.
Lemma ict_mono γ E P P' Φ Φ' e :
(P ⊢ P') → (∀ v n, Φ' v n ⊢ Φ v n) →
{{| P' |}} e @ E {{| Φ' |}}[γ] ⊢ {{| P |}} e @ E {{| Φ |}}[γ].
Proof. by intros; apply always_mono, wand_mono, ic_mono. Qed.
Global Instance ict_mono' γ E :
Proper (flip (⊢) ==> eq ==> pointwise_relation _ ((≡) ==> (⊢)) ==> (⊢)) (ict γ E).
Proof. unfold ict; solve_proper. Qed.
Lemma ict_alt γ E P Φ e :
(P ⊢ IC e @ E {{ Φ }}[γ]) → {{| P |}} e @ E {{| Φ |}}[γ].
Proof. iIntros (Hic) "!# HP". by iApply Hic. Qed.
Lemma ict_val γ E v : {{| True |}} of_val v @ E {{| v', v = v' |}}[γ].
Proof. iIntros "!# _". by iApply ic_value'. Qed.
Lemma ict_vs γ E P P' Φ Φ' e :
(P ={E}=> P') ∧ {{| P' |}} e @ E {{| Φ' |}}[γ] ∧ (∀ v n, Φ' v n ={E}=> Φ v n)
⊢ {{| P |}} e @ E {{| Φ |}}[γ].
Proof.
iIntros "(#Hvs & #Hic & #HΦ) !# HP". iMod ("Hvs" with "HP") as "HP".
iApply ic_fupd; iApply ic_wand_r; iSplitL; [by iApply "Hic"|].
iIntros (v n) "Hv". by iApply "HΦ".
Qed.
Lemma ict_bind `{LanguageCtx Λ K} γ E P Φ Φ' e :
{{| P |}} e @ E {{| Φ |}}[γ] ∧
(∀ v n, {{| Φ v n |}} K (of_val v) @ E {{| w; m, Φ' w (n + m) |}}[γ])
⊢ {{| P |}} K e @ E {{| Φ' |}}[γ].
Proof.
iIntros "[#Hice #HicK] !# HP". iApply ic_bind.
iApply ic_wand_r; iSplitL; [by iApply "Hice"|].
iIntros (v n) "Hv". by iApply "HicK".
Qed.
Lemma ict_mask_weaken γ E1 E2 P Φ e :
E1 ⊆ E2 → {{| P |}} e @ E1 {{| Φ |}}[γ] ⊢ {{| P |}} e @ E2 {{| Φ |}}[γ].
Proof.
iIntros (?) "#Hic !# HP". iApply (ic_mask_mono _ E1 E2); try done.
by iApply "Hic".
Qed.
Lemma ict_frame_l γ E P Φ R e :
{{| P |}} e @ E {{| Φ |}}[γ] ⊢ {{| R ★ P |}} e @ E {{| v; n, R ★ Φ v n |}}[γ].
Proof. iIntros "#Hic !# [$ HP]". by iApply "Hic". Qed.
Lemma ict_frame_r γ E P Φ R e :
{{| P |}} e @ E {{| Φ |}}[γ] ⊢ {{| P ★ R |}} e @ E {{| v; n, Φ v n ★ R |}}[γ].
Proof. iIntros "#Hic !# [HP $]". by iApply "Hic". Qed.
End hoare.
From iris.base_logic.lib Require Export viewshifts.
From iris.proofmode Require Import tactics.
Definition ict `{ICState Λ, ICG Λ Σ} γ (E : coPset) (P : iProp Σ)
(e : expr Λ) (Φ : val Λ → nat → iProp Σ) : iProp Σ :=
(□ (P -★ IC e @ E {{ Φ }}[γ]))%I.
Instance: Params (@ict) 5.
Notation "{{| P |} } e @ E {{| Φ |} }[ γ ]" := (ict γ E P e%E Φ)
(at level 20, P, e, Φ at level 200,
format "{{| P |} } e @ E {{| Φ |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e {{| Φ |} }[ γ ]" := (ict γ ⊤ P e%E Φ)
(at level 20, P, e, Φ at level 200,
format "{{| P |} } e {{| Φ |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e @ E {{| Φ |} }[ γ ]" := (True ⊢ ict γ E P e%E Φ)
(at level 20, P, e, Φ at level 200,
format "{{| P |} } e @ E {{| Φ |} }[ γ ]") : C_scope.
Notation "{{| P |} } e {{| Φ |} }[ γ ]" := (True ⊢ ict γ ⊤ P e%E Φ)
(at level 20, P, e, Φ at level 200,
format "{{| P |} } e {{| Φ |} }[ γ ]") : C_scope.
Notation "{{| P |} } e @ E {{| v ; n , Q |} }[ γ ]" := (ict γ E P e%E (λ v n, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e @ E {{| v ; n , Q |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e @ E {{| v , Q |} }[ γ ]" := (ict γ E P e%E (λ v _, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e @ E {{| v , Q |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e {{| v ; n , Q |} }[ γ ]" := (ict γ ⊤ P e%E (λ v n, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e {{| v ; n , Q |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e {{| v , Q |} }[ γ ]" := (ict γ ⊤ P e%E (λ v _, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e {{| v , Q |} }[ γ ]") : uPred_scope.
Notation "{{| P |} } e @ E {{| v ; n , Q |} }[ γ ]" := (True ⊢ ict γ E P e%E (λ v n, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e @ E {{| v ; n , Q |} }[ γ ]") : C_scope.
Notation "{{| P |} } e @ E {{| v , Q |} }[ γ ]" := (True ⊢ ict γ E P e%E (λ v _, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e @ E {{| v , Q |} }[ γ ]") : C_scope.
Notation "{{| P |} } e {{| v ; n , Q |} }[ γ ]" := (True ⊢ ict γ ⊤ P e%E (λ v n, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e {{| v ; n , Q |} }[ γ ]") : C_scope.
Notation "{{| P |} } e {{| v , Q |} }[ γ ]" := (True ⊢ ict γ ⊤ P e%E (λ v _, Q))
(at level 20, P, e, Q at level 200,
format "{{| P |} } e {{| v , Q |} }[ γ ]") : C_scope.
Section hoare.
Context `{ICState Λ, ICG Λ Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ Ψ : val Λ → nat → iProp Σ.
Implicit Types v : val Λ.
Import uPred.
Global Instance ict_ne γ E n :
Proper (dist n ==> eq==>pointwise_relation _ ((dist n) ==> (dist n)) ==> dist n)
(ict γ E).
Proof. unfold ict; solve_proper. Qed.
Global Instance ict_proper γ E :
Proper ((≡) ==> eq ==> pointwise_relation _ ((≡) ==> (≡)) ==> (≡)) (ict γ E).
Proof. unfold ict; solve_proper. Qed.
Lemma ict_mono γ E P P' Φ Φ' e :
(P ⊢ P') → (∀ v n, Φ' v n ⊢ Φ v n) →
{{| P' |}} e @ E {{| Φ' |}}[γ] ⊢ {{| P |}} e @ E {{| Φ |}}[γ].
Proof. by intros; apply always_mono, wand_mono, ic_mono. Qed.
Global Instance ict_mono' γ E :
Proper (flip (⊢) ==> eq ==> pointwise_relation _ ((≡) ==> (⊢)) ==> (⊢)) (ict γ E).
Proof. unfold ict; solve_proper. Qed.
Lemma ict_alt γ E P Φ e :
(P ⊢ IC e @ E {{ Φ }}[γ]) → {{| P |}} e @ E {{| Φ |}}[γ].
Proof. iIntros (Hic) "!# HP". by iApply Hic. Qed.
Lemma ict_val γ E v : {{| True |}} of_val v @ E {{| v', v = v' |}}[γ].
Proof. iIntros "!# _". by iApply ic_value'. Qed.
Lemma ict_vs γ E P P' Φ Φ' e :
(P ={E}=> P') ∧ {{| P' |}} e @ E {{| Φ' |}}[γ] ∧ (∀ v n, Φ' v n ={E}=> Φ v n)
⊢ {{| P |}} e @ E {{| Φ |}}[γ].
Proof.
iIntros "(#Hvs & #Hic & #HΦ) !# HP". iMod ("Hvs" with "HP") as "HP".
iApply ic_fupd; iApply ic_wand_r; iSplitL; [by iApply "Hic"|].
iIntros (v n) "Hv". by iApply "HΦ".
Qed.
Lemma ict_bind `{LanguageCtx Λ K} γ E P Φ Φ' e :
{{| P |}} e @ E {{| Φ |}}[γ] ∧
(∀ v n, {{| Φ v n |}} K (of_val v) @ E {{| w; m, Φ' w (n + m) |}}[γ])
⊢ {{| P |}} K e @ E {{| Φ' |}}[γ].
Proof.
iIntros "[#Hice #HicK] !# HP". iApply ic_bind.
iApply ic_wand_r; iSplitL; [by iApply "Hice"|].
iIntros (v n) "Hv". by iApply "HicK".
Qed.
Lemma ict_mask_weaken γ E1 E2 P Φ e :
E1 ⊆ E2 → {{| P |}} e @ E1 {{| Φ |}}[γ] ⊢ {{| P |}} e @ E2 {{| Φ |}}[γ].
Proof.
iIntros (?) "#Hic !# HP". iApply (ic_mask_mono _ E1 E2); try done.
by iApply "Hic".
Qed.
Lemma ict_frame_l γ E P Φ R e :
{{| P |}} e @ E {{| Φ |}}[γ] ⊢ {{| R ★ P |}} e @ E {{| v; n, R ★ Φ v n |}}[γ].
Proof. iIntros "#Hic !# [$ HP]". by iApply "Hic". Qed.
Lemma ict_frame_r γ E P Φ R e :
{{| P |}} e @ E {{| Φ |}}[γ] ⊢ {{| P ★ R |}} e @ E {{| v; n, Φ v n ★ R |}}[γ].
Proof. iIntros "#Hic !# [HP $]". by iApply "Hic". Qed.
End hoare.