LogrelCC.soundness_binary

From LogrelCC Require Export context_refinement.
From iris.algebra Require Import auth frac agree.
From iris.proofmode Require Import tactics.
From LogrelCC.program_logic Require Import adequacy.
From LogrelCC Require Import soundness_unary.

Lemma basic_soundness Σ `{heapPreIG Σ, inG Σ (authR cfgUR)}
    e e' τ v thp hp :
  ( `{heapG Σ, cfgSG Σ}, [] e log e' : τ)
  rtc step ([e], ) (of_val v :: thp, hp)
  ( thp' hp' v', rtc step ([e'], ) (of_val v' :: thp', hp')).
Proof.
  intros Hlog Hsteps.
  cut (adequate NotStuck e (λ _, thp' h v, rtc step ([e'], ) (of_val v :: thp', h))).
  { destruct 1; naive_solver. }
  eapply (wp_adequacy Σ _); iIntros (Hinv).
  iMod (own_alloc ( to_gen_heap )) as (γ) "Hh".
  { apply (auth_auth_valid _ (to_gen_heap_valid _ _ )). }
  iMod (own_alloc ( (to_tpool [e'], )
     ((to_tpool [e'] : tpoolUR, ) : cfgUR))) as (γc) "[Hcfg1 Hcfg2]".
  { apply auth_valid_discrete_2. split=>//. split=>//. apply to_tpool_valid. }
  set (Hcfg := CFGSG _ _ γc).
  iMod (inv_alloc specN _ (spec_inv ([e'], )) with "[Hcfg1]") as "#Hcfg".
  { iNext. iExists [e'], . rewrite /to_gen_heap fin_maps.map_fmap_empty. auto. }
  set (HeapΣ := (HeapG Σ Hinv (GenHeapG _ _ Σ _ _ _ γ))).
  iExists (λ σ, own γ ( to_gen_heap σ)); iFrame.
  iApply wp_fupd. iApply wp_wand_r.
  iSplitL.
  - iPoseProof ((Hlog _ _ [] [] ([e'], )) with "[$Hcfg]") as "Hrel".
    { by iApply (@logrel_binary.interp_env_nil Σ HeapΣ). }
    simpl.
    rewrite empty_env_subst empty_env_subst. iApply ("Hrel" $! ([], []) 0).
    { rewrite /tpool_mapsto. asimpl. iFrame.
      iModIntro; iAlways.
      iIntros (??) "[? ?]" => /=. iApply wp_value; eauto using to_of_val. }
  - iModIntro. iIntros (_) ; iDestruct 1 as (v2) "Hj".
    iInv specN as (tp σ) ">[Hown Hsteps]" "Hclose"; iDestruct "Hsteps" as %Hsteps'.
    rewrite /tpool_mapsto /=.
    iDestruct (own_valid_2 with "Hown Hj") as %Hvalid.
    move: Hvalid=> /auth_valid_discrete_2
                   [/prod_included [/tpool_singleton_included Hv2 _] _].
    destruct tp as [|? tp']; simplify_eq/=.
    iMod ("Hclose" with "[-]") as "_"; [iExists (_ :: tp'), σ; auto|].
    iIntros "!> !%"; eauto.
Qed.

Lemma binary_soundness Σ `{heapPreIG Σ, inG Σ (authR cfgUR)}
    Γ e e' τ :
  ( f, e.[upn (length Γ) f] = e)
  ( f, e'.[upn (length Γ) f] = e')
  ( `{heapG Σ, cfgSG Σ}, Γ e log e' : τ)
  Γ e ctx e' : τ.
Proof.
  intros He He' Hlog K thp σ v ?. eapply (basic_soundness Σ _)=> ??.
  eapply (bin_log_related_under_typed_ctx _ _ _ _ []); eauto.
Qed.