Commit 5179b6c8 authored by Dan Frumin's avatar Dan Frumin

Initial import of tactics for logrels

parent e2bca994
......@@ -2,7 +2,7 @@ From iris.proofmode Require Import tactics.
From iris.algebra Require Import auth.
From iris.base_logic Require Import lib.auth.
From iris_logrel.F_mu_ref_conc Require Export examples.lock.
From iris_logrel.F_mu_ref_conc Require Import tactics soundness_binary relational_properties.
From iris_logrel.F_mu_ref_conc Require Import tactics rel_tactics soundness_binary relational_properties.
From iris.program_logic Require Import adequacy.
From iris_logrel.F_mu_ref_conc Require Import hax.
......@@ -68,16 +68,15 @@ Section CG_Counter.
{E1,E2;Γ} t log fill K (App (CG_increment (Loc x)) Unit) : τ.
Proof.
iIntros (?) "Hx Hlog".
rel_bind_r (CG_increment (#x))%E.
unfold CG_increment. unlock.
iApply bin_log_related_rec_r; auto. simpl.
iApply bin_log_related_rec_r; auto. simpl.
rel_rec_r.
rel_rec_r.
rel_bind_r (Load (Loc x)).
iApply (bin_log_related_load_r with "Hx");auto.
iIntros "Hx". simpl.
rel_bind_r (BinOp Add _ _).
iApply (bin_log_related_binop_r); auto. simpl.
iApply (bin_log_related_store_r with "Hx"); auto.
rel_op_r.
rel_store_r.
by iApply "Hlog".
Qed.
Global Opaque CG_increment.
......@@ -125,29 +124,20 @@ Section CG_Counter.
(x ↦ₛ (#nv n) - l ↦ₛ (#v false) -
(x ↦ₛ (#nv S n) - l ↦ₛ (#v false) -
({E1,E2;Γ} t log fill K (Lit Unit) : τ)) -
{E1,E2;Γ} t log fill K ((lamsubst (lamsubst CG_locked_increment (LocV x)) (LocV l)) Unit) : τ)%I.
{E1,E2;Γ} t log fill K (((CG_locked_increment $/ (LocV x)) $/ (LocV l)) Unit)%E : τ)%I.
Proof.
iIntros (?) "Hx Hl Hlog".
unfold CG_locked_increment. unlock. simpl.
rewrite !Closed_subst_id.
(* rel_bind_r (App _ (#x))%E. *)
(* iApply bin_log_related_rec_r; eauto. simpl. rewrite !Closed_subst_id. *)
(* rel_bind_r (App _ (#l))%E. *)
(* iApply bin_log_related_rec_r; eauto. simpl. rewrite !Closed_subst_id. *)
iApply bin_log_related_rec_r; eauto. simpl.
rel_rec_r.
rel_bind_r (acquire #l).
iApply (bin_log_related_acquire_r with "Hl"); eauto. iIntros "Hl". simpl.
iApply bin_log_related_rec_r; eauto. simpl.
rel_rec_r.
rel_bind_r (CG_increment #x #())%E.
iApply (bin_log_related_CG_increment_r with "Hx"); auto. simpl. iIntros "Hx".
iApply bin_log_related_rec_r; eauto. simpl.
rel_rec_r.
iApply (bin_log_related_release_r with "Hl"); eauto.
by iApply "Hlog".
(* iApply (bin_log_related_with_lock_r Γ K E1 E2 (x ↦ₛ (#nv S n)) _ Unit Unit with "[Hx] Hl"); eauto. *)
(* - simpl. by rewrite decide_left. *)
(* - iIntros (K') "Hlog". *)
(* iApply bin_log_related_rec_r; eauto. simpl. rewrite !Closed_subst_id. *)
(* iApply (bin_log_related_CG_increment_r with "Hx"); auto. *)
Qed.
Global Opaque CG_locked_increment.
......@@ -274,7 +264,7 @@ Section CG_Counter.
Proof.
iIntros "Hx Hlog".
Transparent counter_read. unfold counter_read. unlock. simpl.
iApply bin_log_related_rec_r; auto. simpl.
rel_rec_r.
iApply (bin_log_related_load_r with "Hx"); auto.
Opaque counter_read.
Qed.
......@@ -362,21 +352,11 @@ Section CG_Counter.
iApply (bin_log_related_rec_l _ []); auto.
iNext. simpl.
rel_bind_r (App _ (#cnt')%E).
Transparent CG_locked_increment.
unfold CG_locked_increment. unlock.
iApply (bin_log_related_rec_r _ _); auto. simpl. rewrite !Closed_subst_id.
iApply (bin_log_related_rec_r _ _ _ []); auto. simpl. rewrite !Closed_subst_id.
(* rel_bind_r (App _ (λ: "l", _))%E. *)
(* Transparent with_lock. unfold with_lock. unlock. *)
(* iApply (bin_log_related_rec_r Γ); eauto. *)
(* { simpl. by rewrite decide_left. } *)
(* simpl. rewrite !Closed_subst_id. *)
(* iApply (bin_log_related_rec_r _ _ _ []); eauto. simpl. rewrite !Closed_subst_id. *)
rel_rec_r.
rel_rec_r.
iApply bin_log_related_arrow.
iAlways. iIntros (Δ [v v']) "[% %]"; simpl in *; subst. clear Δ.
......@@ -419,8 +399,8 @@ Section CG_Counter.
iIntros "#Hinv".
Transparent counter_read.
unfold counter_read. unlock.
iApply (bin_log_related_rec_r _ _ _ []); auto. simpl.
iApply (bin_log_related_rec_l _ _ []); auto. simpl. iNext.
rel_rec_r.
rel_rec_l.
iApply bin_log_related_arrow. iAlways.
iIntros (Δ [v v']) "[% %]"; simpl in *; subst. clear Δ.
(* :( *)
......@@ -453,27 +433,19 @@ Section CG_Counter.
rel_bind_r newlock.
iApply (bin_log_related_newlock_r); auto; simpl.
iIntros (l) "Hl".
iApply (bin_log_related_rec_r _ _ _ []); auto. rewrite /= !Closed_subst_id /=.
rel_rec_r.
rel_alloc_r as cnt' "Hcnt'".
rel_bind_l (Alloc _).
iApply (bin_log_related_alloc_l); auto; simpl. iModIntro.
iIntros (cnt) "Hcnt".
rel_bind_r (Alloc _).
iApply (bin_log_related_alloc_r); auto.
iIntros (cnt') "Hcnt' /=".
iApply (bin_log_related_rec_r _ _ _ []); auto. simpl.
rewrite /= !Closed_subst_id /=.
rel_rec_r.
unfold FG_counter_body. unlock.
iApply (bin_log_related_rec_l _ _ []); auto.
iNext. rewrite /= !Closed_subst_id /=.
rel_rec_l.
rel_bind_r (CG_counter_body _).
unfold CG_counter_body. unlock.
iApply (bin_log_related_rec_r _ _); auto.
rewrite /= !Closed_subst_id /=.
iApply (bin_log_related_rec_r _ _ _ []); auto.
rewrite /= !Closed_subst_id /=.
do 2 rel_rec_r.
(* establishing the invariant *)
iAssert (counter_inv l cnt cnt')
......
......@@ -2,16 +2,11 @@ From iris.proofmode Require Import tactics.
From iris.algebra Require Import auth.
From iris.base_logic Require Import lib.auth.
From iris_logrel.F_mu_ref_conc Require Export examples.lock.
From iris_logrel.F_mu_ref_conc Require Import tactics soundness_binary relational_properties.
From iris_logrel.F_mu_ref_conc Require Import tactics rel_tactics soundness_binary relational_properties.
From iris.program_logic Require Import adequacy.
From iris_logrel.F_mu_ref_conc Require Import hax.
Notation "'let:' x := e1 'in' e2" := (Let x%bind e1%E e2%E)
(at level 102, x at level 1, e1, e2 at level 200,
format "'[' '[hv' 'let:' x := '[' e1 ']' 'in' ']' '/' e2 ']'") : expr_scope.
Notation "e $! v" := (lamsubst e%E v%V) (at level 80) : expr_scope.
Definition rand : val := λ: <>,
let: "y" := (ref (# false))
in Fork ("y" <- # true);;
......
From iris.proofmode Require Import tactics.
From iris_logrel.F_mu_ref_conc Require Import tactics.
From iris_logrel.F_mu_ref_conc Require Import tactics rel_tactics.
From iris_logrel.F_mu_ref_conc Require Export rules_binary typing fundamental_binary relational_properties notation.
From iris.base_logic Require Import namespaces.
......@@ -73,7 +73,8 @@ Section proof.
Proof.
iIntros "Hlog".
unfold newlock.
iApply (bin_log_related_alloc_r); auto.
rel_alloc_r as l "Hl".
iApply ("Hlog" with "Hl").
Qed.
Global Opaque newlock.
......@@ -100,11 +101,11 @@ Section proof.
Proof.
iIntros "Hl Hlog".
unfold acquire.
iApply bin_log_related_rec_r; eauto. simpl.
rel_rec_r.
rel_bind_r (CAS _ _ _).
iApply (bin_log_related_cas_suc_r with "Hl"); auto.
iIntros "Hl". rewrite fill_app /=.
iApply bin_log_related_if_true_r; auto.
iIntros "Hl". simpl.
rel_if_r.
by iApply "Hlog".
Qed.
......@@ -130,8 +131,9 @@ Section proof.
Proof.
iIntros "Hl Hlog".
unfold release.
iApply (bin_log_related_rec_r); auto. simpl.
iApply (bin_log_related_store_r with "Hl"); auto.
rel_rec_r.
rel_store_r.
by iApply "Hlog".
Qed.
Global Opaque release.
......@@ -187,7 +189,7 @@ Section proof.
iApply (bin_log_related_rec_r); eauto. simpl. rewrite !Closed_subst_id.
iApply (bin_log_related_rec_r); eauto. simpl. rewrite !Closed_subst_id.
rel_bind_r (App acquire (Loc l)).
iApply (bin_log_related_acquire_r Γ (_ ++ K) l with "Hl"); auto.
iApply (bin_log_related_acquire_r Γ (_ :: K) l with "Hl"); auto.
iIntros "Hl". simpl.
iApply (bin_log_related_rec_r); eauto. simpl.
rel_bind_r (App e ew).
......
......@@ -9,6 +9,8 @@ Definition lamsubst (e : expr) (v : val) : expr :=
| _ => e
end.
Notation "e $/ v" := (lamsubst e%E v%V) (at level 80) : expr_scope.
Ltac inv_head_step :=
repeat match goal with
| _ => progress simplify_map_eq/= (* simplify memory stuff *)
......
......@@ -67,4 +67,8 @@ Notation "'Λ:' e" := (TLam e%E)
Notation "'Λ:' e" := (TLamV e%E)
(at level 102, e at level 200) : val_scope.
Notation "'let:' x := e1 'in' e2" := (Let x%bind e1%E e2%E)
(at level 102, x at level 1, e1, e2 at level 200,
format "'[' '[hv' 'let:' x := '[' e1 ']' 'in' ']' '/' e2 ']'") : expr_scope.
Coercion of_val : val >-> expr.
This diff is collapsed.
......@@ -630,7 +630,7 @@ Section properties.
{ econstructor; eauto. }
Qed.
Lemma bin_log_related_inl_r Γ E1 E2 K e v e1 e2 t τ
Lemma bin_log_related_case_inl_r Γ E1 E2 K e v e1 e2 t τ
(Hclosed1 : Closed e1)
(Hclosed2 : Closed e2)
(Hval : to_val e = Some v)
......@@ -643,7 +643,7 @@ Section properties.
{ econstructor; eauto. }
Qed.
Lemma bin_log_related_inr_r Γ E1 E2 K e v e1 e2 t τ
Lemma bin_log_related_case_inr_r Γ E1 E2 K e v e1 e2 t τ
(Hclosed1 : Closed e1)
(Hclosed2 : Closed e2)
(Hval : to_val e = Some v)
......@@ -831,26 +831,3 @@ Section properties.
(* To prevent accidental unfolding by iMod or other tactics *)
Typeclasses Opaque bin_log_related.
End properties.
(* TODO: those should be accompaied by lemmas; preferably so that
[change] does not change too much *)
Tactic Notation "rel_bind_l" open_constr(efoc) :=
iStartProof;
lazymatch goal with
| [ |- (_ bin_log_related _ _ _ (fill _ ?e) _ _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e')); try (rewrite -fill_app)
| [ |- (_ bin_log_related _ _ _ ?e _ _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e')); try (rewrite -fill_app)
end.
Tactic Notation "rel_bind_r" open_constr(efoc) :=
iStartProof;
lazymatch goal with
| [ |- (_ bin_log_related _ _ _ _ (fill _ ?e) _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e')); try (rewrite -fill_app)
| [ |- (_ bin_log_related _ _ _ _ ?e _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e')); try (rewrite -fill_app)
end.
......@@ -19,6 +19,7 @@ F_mu_ref_conc/fundamental_binary.v
F_mu_ref_conc/context_refinement.v
F_mu_ref_conc/soundness_binary.v
F_mu_ref_conc/tactics.v
F_mu_ref_conc/rel_tactics.v
F_mu_ref_conc/notation.v
F_mu_ref_conc/examples/lock.v
F_mu_ref_conc/examples/counter.v
......
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