Commit b3e7473a authored by Dan Frumin's avatar Dan Frumin

Clean up the repository

- Remove commented out code
- Pull std++ related lemmas into a separate file
parent 2f7d7bde
(* This module defines binders and liftings of all the necessary
operations/lemmas. *)
From stdpp Require Import strings gmap mapset stringmap.
From iris_logrel.prelude Require Export base.
From iris.algebra Require Export base.
Inductive binder := BAnon | BNamed : string binder.
......@@ -44,16 +44,6 @@ Instance singleton_binder_set : Singleton binder stringset :=
end.
(** Properties lifts *)
(* TODO: move this somewhere else *)
Lemma difference_empty_map {K A} `{EqDecision K} `{Countable K} (X : gmap K A) :
X = X.
Proof.
apply map_eq => i.
remember (X !! i) as Z. destruct Z.
- apply lookup_difference_Some. split; eauto.
- apply lookup_difference_None. left; eauto.
Qed.
Lemma dom_delete_binder {A} (i : binder) (m : stringmap A) :
dom (gset string) (delete i m) (dom (gset string) m) {[i]}.
Proof.
......@@ -77,21 +67,6 @@ Lemma cons_binder_union (i : binder) (X : gset string) :
i :b: X = {[i]} X.
Proof. destruct i; cbn-[union]; eauto. set_solver. Qed.
(* TODO: move this somewhere else *)
Lemma singleton_union_difference (X Y : stringset) (x : string) :
{[x]} (X Y) = ({[x]} X) (Y {[x]}).
Proof.
unfold_leibniz. intros y. split; intro Hy.
- apply elem_of_union in Hy. set_solver.
- apply elem_of_difference in Hy. destruct Hy as [Hy1 Hy2].
apply elem_of_union in Hy1.
rewrite elem_of_union. rewrite elem_of_difference.
rewrite elem_of_singleton.
destruct (decide (x = y)); subst; eauto.
assert (y {[x]}). intro K; apply elem_of_singleton in K. auto.
right. destruct Hy1; set_solver.
Qed.
Lemma lookup_insert_binder {A} (i : binder) (j : string) (x : A) (m : stringmap A):
i = BNamed j <[i:=x]>m !! j = Some x.
Proof. intros ->. apply lookup_insert. Qed.
......@@ -152,10 +127,6 @@ Lemma delete_commute_binder {A} (m : stringmap A) (i j : binder) :
delete i (delete j m) = delete j (delete i m).
Proof. destruct i, j; cbn; auto. apply delete_commute. Qed.
(* TODO: move it to stdpp *)
Lemma delete_singleton_ne {A} (i j : string) (x : A) : j i delete i {[j := x]} = {[j := x]}.
Proof. intros Hij. apply delete_notin. by apply lookup_singleton_ne. Qed.
Lemma delete_empty_binder {A} (x : binder) :
delete x ( : stringmap A) = .
Proof. destruct x; cbn; eauto. apply delete_empty. Qed.
......@@ -181,3 +152,9 @@ Proof.
destruct x; cbn; auto.
by rewrite fmap_insert.
Qed.
Lemma delete_idem_binder {A} (x : binder) (m : stringmap A) :
delete x (delete x m) = delete x m.
Proof.
destruct x; cbn; eauto. apply delete_idem.
Qed.
......@@ -42,28 +42,6 @@ Section CG_Counter.
repeat econstructor; eauto; cbn; seq_map_lookup.
Qed.
(* TODO: this is copypasta from lock.v *)
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.
Lemma steps_CG_increment E ρ j K x n:
nclose specN E
spec_ctx ρ - x ↦ₛ (#nv n)
......@@ -383,6 +361,32 @@ Section CG_Counter.
iApply "IH".
Qed.
(* Lemma wp_step_back Γ (e t : expr) (x : string) (v ev : val) τ : *)
(* Closed (Lam x e) *)
(* to_val (lang.subst x (of_val v) e) = Some ev *)
(* Γ (App (Lam x e) v) log t : τ *)
(* Γ (lang.subst x (of_val v) e) log t : τ. *)
(* Proof. *)
(* iIntros (??) "Hr". *)
(* Transparent bin_log_related. *)
(* iIntros (Δ vvs ρ) "#Hs #HΓ"; iIntros (j K) "Hj". *)
(* cbn-[subst_p]. *)
(* (* assert (Closed (lang.subst x v e)). *) *)
(* (* { eapply is_closed_subst_preserve; eauto. solve_closed. } *) *)
(* rewrite /env_subst !Closed_subst_p_id. *)
(* iSpecialize ("Hr" with "Hs []"). *)
(* { iAlways. by iFrame. } *)
(* rewrite /env_subst. erewrite (Closed_subst_p_id (fst <$> vvs)); last first. *)
(* { rewrite /Closed. simpl. *)
(* rewrite /Closed /= in H1. split_and; eauto; try solve_closed. } *)
(* iMod ("Hr" with "Hj") as "Hr". *)
(* iModIntro. simpl. *)
(* rewrite {1}wp_unfold /wp_pre /=. *)
(* iApply wp_value; eauto. *)
(* iApply (wp_bind_inv in "Hr". *)
(* Opaque bin_log_related. *)
(* TODO: try to use with_lock rules *)
Lemma FG_CG_increment_refinement l cnt cnt' Γ :
inv counterN (counter_inv l cnt cnt') -
......
......@@ -12,9 +12,6 @@ Definition acquire : val :=
(Unit)
(App "acquire" "x")).
(* TODO: move to notation.v *)
Coercion of_val : val >-> expr.
(** [release = λ x. x <- false] *)
Definition release : val := LamV "x" (Store "x" (# false)).
(** [with_lock e l = λ x. (acquire l) ;; e x ;; (release l)] *)
......@@ -109,29 +106,6 @@ Section proof.
by iFrame.
Qed.
(* 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'))
| [ |- (_ bin_log_related _ _ _ ?e _ _ ) ] =>
reshape_expr e ltac:(fun K e' =>
unify e' efoc; change e with (fill K e'))
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.
Lemma bin_log_related_acquire_r Γ E1 E2 K l t τ
(Hspec : nclose specN E1) :
l ↦ₛ (#v false) -
......
......@@ -28,7 +28,7 @@ Section masked.
let vh := iFresh in
iIntros vh;
try (iMod vh);
iDestruct vh as (w) (String.append "[Hj " (String.append Hv " ]")); simpl. (* ; iApply fupd_wp. *)
iDestruct vh as (w) (String.append "[Hj " (String.append Hv " ]")); simpl.
Lemma bin_log_related_var Γ x τ :
Γ !! x = Some τ
......@@ -125,28 +125,7 @@ Section masked.
iSpecialize ("IH1" with "IH2 Hj").
by iMod "IH1".
Qed.
(* TODO: move to std++ *)
Lemma difference_union_id {A : Type} `{EqDecision A, Countable A} (X Y : gset A):
X Y Y = X Y.
Proof.
unfold_leibniz. intro x.
rewrite !elem_of_union elem_of_difference.
split.
- set_solver.
- destruct (decide (x Y)); set_solver.
Qed.
(* TODO: move to std++ *)
Lemma difference_empty {A: Type} `{EqDecision A, Countable A} (X : gset A) :
X = X.
Proof.
unfold_leibniz.
rewrite <- (right_id union (X )).
rewrite <- (right_id union X) at 2.
fold_leibniz.
apply difference_union_id.
Qed.
Lemma bin_log_related_rec (Γ : stringmap type) (f x : binder) (e e' : expr) τ1 τ2 :
Closed (x :b: f :b: dom _ Γ) e
Closed (x :b: f :b: dom _ Γ) e'
......
......@@ -67,3 +67,4 @@ Notation "'Λ:' e" := (TLam e%E)
Notation "'Λ:' e" := (TLamV e%E)
(at level 102, e at level 200) : val_scope.
Coercion of_val : val >-> expr.
......@@ -14,31 +14,6 @@ Section properties.
(** * Lemmas to show that binary logical model is closed under
(forward) reductions. *)
(* Lemma interp_expr_mono (E E' : coPset) Δ τ : *)
(* (E E') *)
(* ( v, interp_expr E E (interp E E τ) Δ v - interp_expr E' E' (interp E E τ) Δ v)%I. *)
(* Proof. *)
(* iIntros (?). *)
(* iInduction τ as [] "IH"; simpl; iIntros (v) "H"; *)
(* iIntros (j K) "Hj"; iSpecialize ("H" with "* Hj"); *)
(* iApply (wp_mask_mono E); auto; *)
(* iApply fupd_wp; auto. *)
(* Qed. *)
(* Lemma interp_expr_mono2 (E E' : coPset) (P Q : listC D -n> D) Δ : *)
(* (E E') *)
(* ( (x : listC D) w, P x w - Q x w) - *)
(* ( v, interp_expr E E P Δ v - interp_expr E' E' Q Δ v)%I. *)
(* Proof. *)
(* iIntros (?) "HPQ". iIntros (vv) "H". *)
(* iIntros (j K) "Hj". iSpecialize ("H" with "Hj"). iModIntro. *)
(* iApply (wp_mask_mono E); auto. *)
(* iApply fupd_wp; auto. *)
(* iMod "H". iModIntro. *)
(* iApply (wp_wand with "H [HPQ]"). *)
(* iIntros (v) "Hv". iDestruct "Hv" as (v') "[Hj HP]". *)
(* iExists _; iFrame. by iApply "HPQ". *)
(* Qed. *)
(* We need this to be able to open and closed invariants in front of logrels *)
Lemma fupd_logrel Γ E1 E2 e e' τ :
((|={E1,E2}=> ({E2,E2;Γ} e log e' : τ))
......@@ -738,8 +713,6 @@ Section properties.
econstructor; eauto.
Qed.
(* TODO difference btween |={}=> and |==> *)
(* note: also can put an update after the quantifier (in addition to the one present *)
(** Stateful reductions *)
Lemma bin_log_related_step_r Φ Γ E1 E2 K' e1 e2 τ
(Hclosed2 : Closed e2) :
......@@ -866,5 +839,27 @@ 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.
This diff is collapsed.
From iris_logrel.F_mu_ref_conc Require Export lang notation subst.
From iris_logrel.prelude Require Export base.
From stdpp Require Export stringmap gmap mapset.
From Autosubst Require Import Autosubst_Classes. (* for [subst] *)
Inductive type :=
| TUnit : type
......@@ -88,71 +88,6 @@ Definition env_subst := subst_p.
Lemma env_subst_empty (e : expr) : env_subst e = e.
Proof. exact: subst_p_empty. Qed.
(* (* TODO: FUNCTIONAL EXTENSIONALITY *) *)
(* Require Import Coq.Logic.FunctionalExtensionality. *)
(* Lemma env_subst_add (e : expr) (x : string) (v : val) vs : *)
(* vs !! x = None *)
(* env_subst (<[x:=v]>vs) e = lang.subst x (of_val v) (env_subst vs e). *)
(* Proof. cbv[env_subst]. intros ?. *)
(* rewrite map_fold_insert. reflexivity. *)
(* intros j1 j2 z1 z2 f Hj Hz1 Hz2. *)
(* apply functional_extensionality. *)
(* intro f0. apply subst_subst_ne; eauto. *)
(* apply H. *)
(* Qed. *)
(* Lemma env_subst_commute_3 (g : expr expr expr expr) (vs : stringmap val) : *)
(* ( e1 e2 e3 x v, lang.subst x v (g e1 e2 e3) = g (lang.subst x v e1) (lang.subst x v e2) (lang.subst x v e3)) *)
(* forall e1 e2 e3, env_subst vs (g e1 e2 e3) = g (env_subst vs e1) (env_subst vs e2) (env_subst vs e3). *)
(* Proof. *)
(* intros Hcomm e1 e2 e3. *)
(* pose (P:=(λ (_ : expr expr) vs, env_subst vs (g e1 e2 e3) = g (env_subst vs e1) (env_subst vs e2) (env_subst vs e3))). *)
(* apply (map_fold_ind P (λ _ _, id) id); unfold P; simpl. *)
(* - by rewrite ?env_subst_empty. *)
(* - intros i vv m _ Hi IH. rewrite ?env_subst_add; auto. *)
(* rewrite IH. apply Hcomm. *)
(* Qed. *)
(* Lemma env_subst_commute_2 (g : expr expr expr) (vs : stringmap val) : *)
(* ( e1 e2 x v, lang.subst x v (g e1 e2) = g (lang.subst x v e1) (lang.subst x v e2)) *)
(* forall e1 e2, env_subst vs (g e1 e2) = g (env_subst vs e1) (env_subst vs e2). *)
(* Proof. *)
(* intros Hcomm e1 e2. *)
(* pose (P:=(λ (_ : expr expr) vs, env_subst vs (g e1 e2) = g (env_subst vs e1) (env_subst vs e2))). *)
(* apply (map_fold_ind P (λ _ _, id) id); unfold P; simpl. *)
(* - by rewrite ?env_subst_empty. *)
(* - intros i vv m _ Hi IH. rewrite ?env_subst_add; auto. *)
(* rewrite IH. apply Hcomm. *)
(* Qed. *)
(* Lemma env_subst_commute_1 (f : expr expr) (vs : stringmap val) : *)
(* ( e x v, lang.subst x v (f e) = f (lang.subst x v e)) *)
(* forall e, env_subst vs (f e) = f (env_subst vs e). *)
(* Proof. *)
(* intros Hcomm e. *)
(* pose (P:=(λ (_ : expr expr) m, env_subst m (f e) = f (env_subst m e))). *)
(* apply (map_fold_ind P (λ _ _, id) id); unfold P; simpl. *)
(* - by rewrite ?env_subst_empty. *)
(* - intros i vv m _ Hi IH. rewrite ?env_subst_add; auto. *)
(* rewrite IH. apply Hcomm. *)
(* Qed. *)
(* Lemma env_subst_commute_0 (e : expr) (vs : stringmap val) : *)
(* ( x v, lang.subst x v e = e) *)
(* env_subst vs e = e. *)
(* Proof. *)
(* intros Hcomm. *)
(* pose (P:=(λ (_ : expr expr) m, env_subst m e = e)). *)
(* apply (map_fold_ind P (λ _ _, id) id); unfold P; simpl. *)
(* - by rewrite ?env_subst_empty. *)
(* - intros i vv m _ Hi IH. rewrite ?env_subst_add; auto. *)
(* rewrite IH. apply Hcomm. *)
(* Qed. *)
(* Lemma env_subst_of_val (v : val) (vs : stringmap val) : *)
(* env_subst vs (of_val v) = of_val v. *)
(* Proof. apply subst_p_closed_empty. eapply val_closed. Qed. *)
Lemma env_subst_lookup_None (vs : stringmap val) (x : string) :
vs !! x = None
env_subst vs (Var x) = Var x.
......
-Q . iris_logrel
-arg -w -arg -notation-overridden,-redundant-canonical-projection,-several-object-files
prelude/ds.v
prelude/base.v
F_mu_ref_conc/binder.v
F_mu_ref_conc/lang.v
......
......@@ -2,6 +2,7 @@ From iris.algebra Require Export base.
From iris.base_logic Require Import upred.
From iris.program_logic Require Import weakestpre.
From iris.base_logic Require Import invariants.
From iris_logrel.prelude Require Export ds.
From Autosubst Require Export Autosubst.
Import uPred.
......
(* Data structures properties *)
(* TODO: move this to std++ *)
From stdpp Require Export strings gmap mapset stringmap.
From iris.algebra Require Export base. (* for ssreflect stuff *)
Lemma delete_insert_delete {A} (m : stringmap A) (i : string) (x : A) :
delete i (<[i:=x]> m) = delete i m.
Proof.
apply map_eq=>j.
destruct (decide (i = j)) as [Eij|Nij];
simplify_map_eq; auto.
Qed.
Lemma delete_idem {A} (x : string) (m : stringmap A) :
delete x (delete x m) = delete x m.
Proof.
rewrite delete_notin; first done.
apply lookup_delete.
Qed.
Lemma delete_singleton_ne {A} (i j : string) (x : A) :
j i
delete i {[j := x]} = {[j := x]}.
Proof. intros Hij. apply delete_notin. by apply lookup_singleton_ne. Qed.
Lemma difference_empty_map {K A} `{EqDecision K} `{Countable K} (X : gmap K A) :
X = X.
Proof.
apply map_eq => i.
remember (X !! i) as Z. destruct Z.
- apply lookup_difference_Some. split; eauto.
- apply lookup_difference_None. left; eauto.
Qed.
Lemma singleton_union_difference (X Y : stringset) (x : string) :
{[x]} (X Y) = ({[x]} X) (Y {[x]}).
Proof.
unfold_leibniz. intros y. split; intro Hy.
- apply elem_of_union in Hy. set_solver.
- apply elem_of_difference in Hy. destruct Hy as [Hy1 Hy2].
apply elem_of_union in Hy1.
rewrite elem_of_union. rewrite elem_of_difference.
rewrite elem_of_singleton.
destruct (decide (x = y)); subst; eauto.
assert (y {[x]}). intro K; apply elem_of_singleton in K. auto.
right. destruct Hy1; set_solver.
Qed.
Lemma difference_union_id {A : Type} `{EqDecision A, Countable A} (X Y : gset A):
X Y Y = X Y.
Proof.
unfold_leibniz. intro x.
rewrite !elem_of_union elem_of_difference.
split.
- set_solver.
- destruct (decide (x Y)); set_solver.
Qed.
Lemma difference_empty {A: Type} `{EqDecision A, Countable A} (X : gset A) :
X = X.
Proof.
unfold_leibniz.
rewrite <- (right_id union (X )).
rewrite <- (right_id union X) at 2.
fold_leibniz.
apply difference_union_id.
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