From d69c92a7be6bf6437594505b3a94352e2c778d3c Mon Sep 17 00:00:00 2001 From: Jacques-Henri Jourdan <jacques-henri.jourdan@normalesup.org> Date: Thu, 19 Apr 2018 18:18:43 +0200 Subject: [PATCH] Simplify lit_eq. It does not require taking the state in parameter. --- theories/lang/lang.v | 21 ++++++++------------- theories/lang/lifting.v | 2 +- theories/lang/races.v | 8 +------- 3 files changed, 10 insertions(+), 21 deletions(-) diff --git a/theories/lang/lang.v b/theories/lang/lang.v index bf91498c..a21b0eb1 100644 --- a/theories/lang/lang.v +++ b/theories/lang/lang.v @@ -233,15 +233,15 @@ Inductive lit_eq (σ : state) : base_lit → base_lit → Prop := σ !! l2 = None → lit_eq σ (LitLoc l1) (LitLoc l2). -Inductive lit_neq (σ : state) : base_lit → base_lit → Prop := +Inductive lit_neq : base_lit → base_lit → Prop := | IntNeq z1 z2 : - z1 ≠z2 → lit_neq σ (LitInt z1) (LitInt z2) + z1 ≠z2 → lit_neq (LitInt z1) (LitInt z2) | LocNeq l1 l2 : - l1 ≠l2 → lit_neq σ (LitLoc l1) (LitLoc l2) + l1 ≠l2 → lit_neq (LitLoc l1) (LitLoc l2) | LocNeqNullR l : - lit_neq σ (LitLoc l) (LitInt 0) + lit_neq (LitLoc l) (LitInt 0) | LocNeqNullL l : - lit_neq σ (LitInt 0) (LitLoc l). + lit_neq (LitInt 0) (LitLoc l). Inductive bin_op_eval (σ : state) : bin_op → base_lit → base_lit → base_lit → Prop := | BinOpPlus z1 z2 : @@ -253,7 +253,7 @@ Inductive bin_op_eval (σ : state) : bin_op → base_lit → base_lit → base_l | BinOpEqTrue l1 l2 : lit_eq σ l1 l2 → bin_op_eval σ EqOp l1 l2 (lit_of_bool true) | BinOpEqFalse l1 l2 : - lit_neq σ l1 l2 → bin_op_eval σ EqOp l1 l2 (lit_of_bool false) + lit_neq l1 l2 → bin_op_eval σ EqOp l1 l2 (lit_of_bool false) | BinOpOffset l z : bin_op_eval σ OffsetOp (LitLoc l) (LitInt z) (LitLoc $ l +ₗ z). @@ -302,7 +302,7 @@ Inductive head_step : expr → state → expr → state → list expr → Prop : | CasFailS l n e1 lit1 e2 lit2 litl σ : to_val e1 = Some $ LitV lit1 → to_val e2 = Some $ LitV lit2 → σ !! l = Some (RSt n, LitV litl) → - lit_neq σ lit1 litl → + lit_neq lit1 litl → head_step (CAS (Lit $ LitLoc l) e1 e2) σ (Lit $ lit_of_bool false) σ [] | CasSucS l e1 lit1 e2 lit2 litl σ : to_val e1 = Some $ LitV lit1 → to_val e2 = Some $ LitV lit2 → @@ -538,16 +538,11 @@ Lemma lit_eq_state σ1 σ2 l1 l2 : lit_eq σ1 l1 l2 → lit_eq σ2 l1 l2. Proof. intros Heq. inversion 1; econstructor; eauto; eapply Heq; done. Qed. -Lemma lit_neq_state σ1 σ2 l1 l2 : - (∀ l, σ1 !! l = None ↔ σ2 !! l = None) → - lit_neq σ1 l1 l2 → lit_neq σ2 l1 l2. -Proof. intros Heq. inversion 1; econstructor; eauto; eapply Heq; done. Qed. - Lemma bin_op_eval_state σ1 σ2 op l1 l2 l' : (∀ l, σ1 !! l = None ↔ σ2 !! l = None) → bin_op_eval σ1 op l1 l2 l' → bin_op_eval σ2 op l1 l2 l'. Proof. - intros Heq. inversion 1; econstructor; eauto using lit_eq_state, lit_neq_state. + intros Heq. inversion 1; econstructor; eauto using lit_eq_state. Qed. (* Misc *) diff --git a/theories/lang/lifting.v b/theories/lang/lifting.v index 00bd52a0..26a0cdb0 100644 --- a/theories/lang/lifting.v +++ b/theories/lang/lifting.v @@ -20,7 +20,7 @@ Global Opaque iris_invG. Ltac inv_lit := repeat match goal with | H : lit_eq _ ?x ?y |- _ => inversion H; clear H; simplify_eq/= - | H : lit_neq _ ?x ?y |- _ => inversion H; clear H; simplify_eq/= + | H : lit_neq ?x ?y |- _ => inversion H; clear H; simplify_eq/= end. Ltac inv_bin_op_eval := diff --git a/theories/lang/races.v b/theories/lang/races.v index 834b8db7..befd4f49 100644 --- a/theories/lang/races.v +++ b/theories/lang/races.v @@ -16,7 +16,7 @@ Inductive next_access_head : expr → state → access_kind * order → loc → next_access_head (Write ord (Lit $ LitLoc l) e) σ (WriteAcc, ord) l | Access_cas_fail l st e1 lit1 e2 lit2 litl σ : IntoVal e1 (LitV lit1) → IntoVal e2 (LitV lit2) → - lit_neq σ lit1 litl → σ !! l = Some (st, LitV litl) → + lit_neq lit1 litl → σ !! l = Some (st, LitV litl) → next_access_head (CAS (Lit $ LitLoc l) e1 e2) σ (ReadAcc, ScOrd) l | Access_cas_suc l st e1 lit1 e2 lit2 litl σ : IntoVal e1 (LitV lit1) → IntoVal e2 (LitV lit2) → @@ -118,15 +118,9 @@ Proof. intros Ha1 Hstep Ha2. inversion Ha1; subst; clear Ha1; inv_head_step; destruct Ha2; simplify_eq; econstructor; eauto; try apply lookup_insert. (* Oh my. FIXME. *) - - eapply lit_neq_state; last done. - setoid_rewrite <-(not_elem_of_dom (D:=gset loc)). rewrite dom_insert_L. - cut (is_Some (σ !! l)); last by eexists. rewrite -(elem_of_dom (D:=gset loc)). set_solver+. - eapply lit_eq_state; last done. setoid_rewrite <-(not_elem_of_dom (D:=gset loc)). rewrite dom_insert_L. cut (is_Some (σ !! l)); last by eexists. rewrite -(elem_of_dom (D:=gset loc)). set_solver+. - - eapply lit_neq_state; last done. - setoid_rewrite <-(not_elem_of_dom (D:=gset loc)). rewrite dom_insert_L. - cut (is_Some (σ !! l)); last by eexists. rewrite -(elem_of_dom (D:=gset loc)). set_solver+. - eapply lit_eq_state; last done. setoid_rewrite <-(not_elem_of_dom (D:=gset loc)). rewrite dom_insert_L. cut (is_Some (σ !! l)); last by eexists. rewrite -(elem_of_dom (D:=gset loc)). set_solver+. -- GitLab