Commit 73b0c36c authored by Amin Timany's avatar Amin Timany

Prove context refinement for stacks

parent 6663ad8a
...@@ -392,11 +392,14 @@ Section CG_Counter. ...@@ -392,11 +392,14 @@ Section CG_Counter.
End CG_Counter. End CG_Counter.
Definition Σ := #[auth.authGF heapR; auth.authGF cfgR].
Theorem counter_context_refinement : Theorem counter_context_refinement :
context_refines context_refines
[] FG_counter CG_counter [] FG_counter CG_counter
(TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)). (TProd (TArrow TUnit TUnit) (TArrow TUnit TNat)).
Proof. Proof.
eapply Binary_Soundness; eapply (@Binary_Soundness Σ);
auto using FG_counter_closed, CG_counter_closed, FG_CG_counter_refinement. auto using FG_counter_closed, CG_counter_closed, FG_CG_counter_refinement.
all: typeclasses eauto.
Qed. Qed.
\ No newline at end of file
...@@ -2,13 +2,13 @@ From iris.proofmode Require Import invariants ghost_ownership tactics. ...@@ -2,13 +2,13 @@ From iris.proofmode Require Import invariants ghost_ownership tactics.
From iris.program_logic Require Import auth namespaces. From iris.program_logic Require Import auth namespaces.
From iris_logrel.F_mu_ref_par Require Import lang examples.lock From iris_logrel.F_mu_ref_par Require Import lang examples.lock
examples.stack.CG_stack examples.stack.FG_stack examples.stack.stack_rules examples.stack.CG_stack examples.stack.FG_stack examples.stack.stack_rules
typing logrel_binary fundamental_binary rules_binary rules. typing logrel_binary fundamental_binary rules_binary rules
context_refinement soundness_binary.
Import uPred. Import uPred.
Section Stack_refinement. Section Stack_refinement.
Context {Σ : gFunctors} {iS : cfgSG Σ} {iI : heapIG Σ} Context {Σ : gFunctors} {iS : cfgSG Σ} {iI : heapIG Σ}
{iSTK : authG lang Σ stackR}. {iSTK : authG lang Σ stackR}.
Ltac prove_disj N n n' := Ltac prove_disj N n n' :=
let Hneq := fresh "Hneq" in let Hneq := fresh "Hneq" in
let Hdsj := fresh "Hdsj" in let Hdsj := fresh "Hdsj" in
...@@ -518,4 +518,25 @@ Section Stack_refinement. ...@@ -518,4 +518,25 @@ Section Stack_refinement.
end. end.
Qed. Qed.
End Stack_refinement. End Stack_refinement.
\ No newline at end of file
Definition Σ := #[authGF heapR; authGF cfgR; authGF stackR].
Theorem stack_context_refinement :
context_refines
[] FG_stack CG_stack
(TForall
(TProd
(TProd
(TArrow (TVar 0) TUnit)
(TArrow TUnit (TSum TUnit (TVar 0)))
)
(TArrow (TArrow (TVar 0) TUnit) TUnit)
)
).
Proof.
eapply (@Binary_Soundness Σ);
eauto using FG_stack_closed, CG_stack_closed.
all: try typeclasses eauto.
intros. apply FG_CG_counter_refinement.
Qed.
\ No newline at end of file
...@@ -10,9 +10,11 @@ Require Import iris.program_logic.adequacy. ...@@ -10,9 +10,11 @@ Require Import iris.program_logic.adequacy.
Import uPred. Import uPred.
Section Soundness. Section Soundness.
Definition binlogΣ := #[auth.authGF heapR; auth.authGF cfgR]. Context {Σ : gFunctors}
{Hhp : auth.authG lang Σ heapR}
{Hcfg : auth.authG lang Σ cfgR}.
Definition free_type_context : varC -n> bivalC -n> iPropG lang binlogΣ := Definition free_type_context : varC -n> bivalC -n> iPropG lang Σ :=
{| cofe_mor_car := λ x, {| cofe_mor_car := λ y, (True)%I |} |}. {| cofe_mor_car := λ x, {| cofe_mor_car := λ y, (True)%I |} |}.
Local Notation Δφ := free_type_context. Local Notation Δφ := free_type_context.
...@@ -23,8 +25,8 @@ Section Soundness. ...@@ -23,8 +25,8 @@ Section Soundness.
Proof. intros x v; apply const_persistent. Qed. Proof. intros x v; apply const_persistent. Qed.
Lemma wp_basic_soundness e e' τ : Lemma wp_basic_soundness e e' τ :
( Σ H H' N Δ HΔ , @bin_log_related Σ H H' N Δ [] e e' τ HΔ) ( H H' N Δ HΔ , @bin_log_related Σ H H' N Δ [] e e' τ HΔ)
(@ownership.ownP lang (globalF binlogΣ) ) (@ownership.ownP lang (globalF Σ) )
WP e WP e
{{_, ( thp' h v, rtc step ([e'], ) ((# v) :: thp', h))}}. {{_, ( thp' h v, rtc step ([e'], ) ((# v) :: thp', h))}}.
Proof. Proof.
...@@ -43,13 +45,13 @@ Section Soundness. ...@@ -43,13 +45,13 @@ Section Soundness.
} }
iDestruct "Hcfg" as {γ} "Hcfg". rewrite own_op. iDestruct "Hcfg" as {γ} "Hcfg". rewrite own_op.
iDestruct "Hcfg" as "[Hcfg1 Hcfg2]". iDestruct "Hcfg" as "[Hcfg1 Hcfg2]".
iAssert (@auth.auth_inv _ binlogΣ _ _ _ γ (Spec_inv (to_cfg ([e'], )))) iAssert (@auth.auth_inv _ Σ _ _ _ γ (Spec_inv (to_cfg ([e'], ))))
as "Hinv" with "[Hcfg1]". as "Hinv" with "[Hcfg1]".
{ iExists _; iFrame "Hcfg1". apply const_intro; constructor. } { iExists _; iFrame "Hcfg1". apply const_intro; constructor. }
iPvs (inv_alloc (nroot .@ "Fμ,ref,par" .@ 3) with "[Hinv]") as "#Hcfg"; iPvs (inv_alloc (nroot .@ "Fμ,ref,par" .@ 3) with "[Hinv]") as "#Hcfg";
trivial. trivial.
{ iNext. iExact "Hinv". } { iNext. iExact "Hinv". }
iPoseProof (H1 binlogΣ H (@CFGSG _ _ γ) _ Δφ _ [] _ _ 0 [] iPoseProof (H1 H (@CFGSG _ _ γ) _ Δφ _ [] _ _ 0 []
with "[Hcfg2]") as "HBR". with "[Hcfg2]") as "HBR".
{ unfold Spec_ctx, auth.auth_ctx, tpool_mapsto, auth.auth_own. { unfold Spec_ctx, auth.auth_ctx, tpool_mapsto, auth.auth_own.
simpl. rewrite empty_env_subst. by iFrame "Hheap Hcfg Hcfg2". } simpl. rewrite empty_env_subst. by iFrame "Hheap Hcfg Hcfg2". }
...@@ -61,7 +63,7 @@ Section Soundness. ...@@ -61,7 +63,7 @@ Section Soundness.
iDestruct "Hp" as %Hp. iDestruct "Hp" as %Hp.
unfold tpool_mapsto, auth.auth_own; simpl. unfold tpool_mapsto, auth.auth_own; simpl.
iCombine "Hj" "Hown" as "Hown". iCombine "Hj" "Hown" as "Hown".
iDestruct (@own_valid _ binlogΣ (authR cfgR) _ γ _ with "Hown !") iDestruct (@own_valid _ Σ (authR cfgR) _ γ _ with "Hown !")
as "#Hvalid". as "#Hvalid".
iDestruct (auth_validI _ with "Hvalid") as "[Ha' #Hb]"; iDestruct (auth_validI _ with "Hvalid") as "[Ha' #Hb]";
simpl; iClear "Hvalid". simpl; iClear "Hvalid".
...@@ -84,7 +86,7 @@ Section Soundness. ...@@ -84,7 +86,7 @@ Section Soundness.
Qed. Qed.
Lemma basic_soundness e e' τ : Lemma basic_soundness e e' τ :
( Σ H H' N Δ HΔ , @bin_log_related Σ H H' N Δ [] e e' τ HΔ) ( H H' N Δ HΔ , @bin_log_related Σ H H' N Δ [] e e' τ HΔ)
v thp hp, v thp hp,
rtc step ([e], ) ((# v) :: thp, hp) rtc step ([e], ) ((# v) :: thp, hp)
( thp' hp' v', rtc step ([e'], ) ((# v') :: thp', hp')). ( thp' hp' v', rtc step ([e'], ) ((# v') :: thp', hp')).
...@@ -103,12 +105,12 @@ Section Soundness. ...@@ -103,12 +105,12 @@ Section Soundness.
Lemma Binary_Soundness Γ e e' τ : Lemma Binary_Soundness Γ e e' τ :
( f, e.[iter (List.length Γ) up f] = e) ( f, e.[iter (List.length Γ) up f] = e)
( f, e'.[iter (List.length Γ) up f] = e') ( f, e'.[iter (List.length Γ) up f] = e')
( Σ H H' N Δ HΔ , @bin_log_related Σ H H' N Δ Γ e e' τ HΔ) ( H H' N Δ HΔ , @bin_log_related Σ H H' N Δ Γ e e' τ HΔ)
context_refines Γ e e' τ. context_refines Γ e e' τ.
Proof. Proof.
intros H1 K HK htp hp v Hstp Hc Hc'. intros H1 K HK htp hp v Hstp Hc Hc'.
eapply basic_soundness; eauto. eapply basic_soundness; eauto.
intros Σ H H' N Δ HΔ. intros H H' N Δ HΔ.
eapply (bin_log_related_under_typed_context _ _ _ _ []); eauto. eapply (bin_log_related_under_typed_context _ _ _ _ []); eauto.
Qed. Qed.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment