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.