From 60a43009671c8bc6094eb6e7ecf3f484e3fc14eb Mon Sep 17 00:00:00 2001 From: Ralf Jung <jung@mpi-sws.org> Date: Sat, 5 Mar 2016 12:37:53 +0100 Subject: [PATCH] rename Cas -> CAS; make BAnon notation work better --- heap_lang/heap.v | 4 ++-- heap_lang/lang.v | 25 ++++++++++++++----------- heap_lang/lifting.v | 5 ++--- heap_lang/notation.v | 13 +++++++++---- heap_lang/substitution.v | 4 ++-- heap_lang/tactics.v | 4 ++-- 6 files changed, 31 insertions(+), 24 deletions(-) diff --git a/heap_lang/heap.v b/heap_lang/heap.v index 104234360..50bcfc955 100644 --- a/heap_lang/heap.v +++ b/heap_lang/heap.v @@ -200,7 +200,7 @@ Section heap. to_val e1 = Some v1 → to_val e2 = Some v2 → v' ≠v1 → P ⊑ heap_ctx N → nclose N ⊆ E → P ⊑ (▷ l ↦{q} v' ★ ▷ (l ↦{q} v' -★ Φ (LitV (LitBool false)))) → - P ⊑ #> Cas (Loc l) e1 e2 @ E {{ Φ }}. + P ⊑ #> CAS (Loc l) e1 e2 @ E {{ Φ }}. Proof. rewrite /heap_ctx /heap_inv=>????? HPΦ. apply (auth_fsa' heap_inv (wp_fsa _) id) @@ -217,7 +217,7 @@ Section heap. to_val e1 = Some v1 → to_val e2 = Some v2 → P ⊑ heap_ctx N → nclose N ⊆ E → P ⊑ (▷ l ↦ v1 ★ ▷ (l ↦ v2 -★ Φ (LitV (LitBool true)))) → - P ⊑ #> Cas (Loc l) e1 e2 @ E {{ Φ }}. + P ⊑ #> CAS (Loc l) e1 e2 @ E {{ Φ }}. Proof. rewrite /heap_ctx /heap_inv=> ???? HPΦ. apply (auth_fsa' heap_inv (wp_fsa _) (alter (λ _, Frac 1 (DecAgree v2)) l)) diff --git a/heap_lang/lang.v b/heap_lang/lang.v index 1b934de7b..1ee926db1 100644 --- a/heap_lang/lang.v +++ b/heap_lang/lang.v @@ -84,7 +84,7 @@ Inductive expr (X : list string) := | Alloc (e : expr X) | Load (e : expr X) | Store (e1 : expr X) (e2 : expr X) - | Cas (e0 : expr X) (e1 : expr X) (e2 : expr X). + | CAS (e0 : expr X) (e1 : expr X) (e2 : expr X). Bind Scope expr_scope with expr. Delimit Scope expr_scope with E. @@ -106,7 +106,7 @@ Arguments Loc {_} _. Arguments Alloc {_} _%E. Arguments Load {_} _%E. Arguments Store {_} _%E _%E. -Arguments Cas {_} _%E _%E _%E. +Arguments CAS {_} _%E _%E _%E. Inductive val := | RecV (f x : binder) (e : expr (f :b: x :b: [])) @@ -192,9 +192,9 @@ Definition fill_item (Ki : ectx_item) (e : expr []) : expr [] := | LoadCtx => Load e | StoreLCtx e2 => Store e e2 | StoreRCtx v1 => Store (of_val v1) e - | CasLCtx e1 e2 => Cas e e1 e2 - | CasMCtx v0 e2 => Cas (of_val v0) e e2 - | CasRCtx v0 v1 => Cas (of_val v0) (of_val v1) e + | CasLCtx e1 e2 => CAS e e1 e2 + | CasMCtx v0 e2 => CAS (of_val v0) e e2 + | CasRCtx v0 v1 => CAS (of_val v0) (of_val v1) e end. Definition fill (K : ectx) (e : expr []) : expr [] := fold_right fill_item e K. @@ -224,7 +224,7 @@ Program Fixpoint wexpr {X Y} (H : X `included` Y) (e : expr X) : expr Y := | Alloc e => Alloc (wexpr H e) | Load e => Load (wexpr H e) | Store e1 e2 => Store (wexpr H e1) (wexpr H e2) - | Cas e0 e1 e2 => Cas (wexpr H e0) (wexpr H e1) (wexpr H e2) + | CAS e0 e1 e2 => CAS (wexpr H e0) (wexpr H e1) (wexpr H e2) end. Solve Obligations with set_solver. @@ -265,7 +265,7 @@ Program Fixpoint wsubst {X Y} (x : string) (es : expr []) | Alloc e => Alloc (wsubst x es H e) | Load e => Load (wsubst x es H e) | Store e1 e2 => Store (wsubst x es H e1) (wsubst x es H e2) - | Cas e0 e1 e2 => Cas (wsubst x es H e0) (wsubst x es H e1) (wsubst x es H e2) + | CAS e0 e1 e2 => CAS (wsubst x es H e0) (wsubst x es H e1) (wsubst x es H e2) end. Solve Obligations with set_solver. @@ -333,11 +333,11 @@ Inductive head_step : expr [] → state → expr [] → state → option (expr [ | CasFailS l e1 v1 e2 v2 vl σ : to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some vl → vl ≠v1 → - head_step (Cas (Loc l) e1 e2) σ (Lit $ LitBool false) σ None + head_step (CAS (Loc l) e1 e2) σ (Lit $ LitBool false) σ None | CasSucS l e1 v1 e2 v2 σ : to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v1 → - head_step (Cas (Loc l) e1 e2) σ (Lit $ LitBool true) (<[l:=v2]>σ) None. + head_step (CAS (Loc l) e1 e2) σ (Lit $ LitBool true) (<[l:=v2]>σ) None. (** Atomic expressions *) Definition atomic (e: expr []) : Prop := @@ -345,7 +345,7 @@ Definition atomic (e: expr []) : Prop := | Alloc e => is_Some (to_val e) | Load e => is_Some (to_val e) | Store e1 e2 => is_Some (to_val e1) ∧ is_Some (to_val e2) - | Cas e0 e1 e2 => is_Some (to_val e0) ∧ is_Some (to_val e1) ∧ is_Some (to_val e2) + | CAS e0 e1 e2 => is_Some (to_val e0) ∧ is_Some (to_val e1) ∧ is_Some (to_val e2) (* Make "skip" atomic *) | App (Rec _ _ (Lit _)) (Lit _) => True | _ => False @@ -545,7 +545,7 @@ Fixpoint expr_beq {X Y} (e : expr X) (e' : expr Y) : bool := | BinOp op e1 e2, BinOp op' e1' e2' => bool_decide (op = op') && expr_beq e1 e1' && expr_beq e2 e2' | If e0 e1 e2, If e0' e1' e2' | Case e0 e1 e2, Case e0' e1' e2' | - Cas e0 e1 e2, Cas e0' e1' e2' => + CAS e0 e1 e2, CAS e0' e1' e2' => expr_beq e0 e0' && expr_beq e1 e1' && expr_beq e2 e2' | Fst e, Fst e' | Snd e, Snd e' | InjL e, InjL e' | InjR e, InjR e' | Fork e, Fork e' | Alloc e, Alloc e' | Load e, Load e' => expr_beq e e' @@ -595,3 +595,6 @@ Qed. Global Instance heap_lang_ctx_item Ki : LanguageCtx heap_lang (heap_lang.fill_item Ki). Proof. change (LanguageCtx heap_lang (heap_lang.fill [Ki])). apply _. Qed. + +(* Prefer heap_lang names over language names. *) +Export heap_lang. diff --git a/heap_lang/lifting.v b/heap_lang/lifting.v index 0739f9b73..2e8b8fc0e 100644 --- a/heap_lang/lifting.v +++ b/heap_lang/lifting.v @@ -3,7 +3,6 @@ From heap_lang Require Export lang. From program_logic Require Import lifting. From program_logic Require Import ownership. (* for ownP *) From heap_lang Require Import tactics. -Export heap_lang. (* Prefer heap_lang names over language names. *) Import uPred. Local Hint Extern 0 (language.reducible _ _) => do_step ltac:(eauto 2). @@ -58,7 +57,7 @@ Qed. Lemma wp_cas_fail_pst E σ l e1 v1 e2 v2 v' Φ : to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v' → v' ≠v1 → (▷ ownP σ ★ ▷ (ownP σ -★ Φ (LitV $ LitBool false))) - ⊑ #> Cas (Loc l) e1 e2 @ E {{ Φ }}. + ⊑ #> CAS (Loc l) e1 e2 @ E {{ Φ }}. Proof. intros. rewrite -(wp_lift_atomic_det_step σ (LitV $ LitBool false) σ None) ?right_id //; last by intros; inv_step; eauto. @@ -67,7 +66,7 @@ Qed. Lemma wp_cas_suc_pst E σ l e1 v1 e2 v2 Φ : to_val e1 = Some v1 → to_val e2 = Some v2 → σ !! l = Some v1 → (▷ ownP σ ★ ▷ (ownP (<[l:=v2]>σ) -★ Φ (LitV $ LitBool true))) - ⊑ #> Cas (Loc l) e1 e2 @ E {{ Φ }}. + ⊑ #> CAS (Loc l) e1 e2 @ E {{ Φ }}. Proof. intros. rewrite -(wp_lift_atomic_det_step σ (LitV $ LitBool true) (<[l:=v2]>σ) None) ?right_id //; last by intros; inv_step; eauto. diff --git a/heap_lang/notation.v b/heap_lang/notation.v index 36a041104..c92c12716 100644 --- a/heap_lang/notation.v +++ b/heap_lang/notation.v @@ -1,12 +1,13 @@ From heap_lang Require Export derived. +Export heap_lang. Arguments wp {_ _} _ _%E _. -Notation "|| e @ E {{ Φ } }" := (wp E e%E Φ) +Notation "#> e @ E {{ Φ } }" := (wp E e%E Φ) (at level 20, e, Φ at level 200, - format "|| e @ E {{ Φ } }") : uPred_scope. -Notation "|| e {{ Φ } }" := (wp ⊤ e%E Φ) + format "#> e @ E {{ Φ } }") : uPred_scope. +Notation "#> e {{ Φ } }" := (wp ⊤ e%E Φ) (at level 20, e, Φ at level 200, - format "|| e {{ Φ } }") : uPred_scope. + format "#> e {{ Φ } }") : uPred_scope. Coercion LitInt : Z >-> base_lit. Coercion LitBool : bool >-> base_lit. @@ -15,6 +16,7 @@ Coercion of_val : val >-> expr. Coercion BNamed : string >-> binder. Notation "<>" := BAnon : binder_scope. +Notation "<>" := BAnon : expr_scope. (* No scope for the values, does not conflict and scope is often not inferred properly. *) Notation "# l" := (LitV l%Z%V) (at level 8, format "# l"). @@ -33,6 +35,9 @@ Notation "( e1 , e2 , .. , en )" := (Pair .. (Pair e1 e2) .. en) : expr_scope. Notation "'match:' e0 'with' 'InjL' x1 => e1 | 'InjR' x2 => e2 'end'" := (Match e0 x1 e1 x2 e2) (e0, x1, e1, x2, e2 at level 200) : expr_scope. +Notation "'match:' e0 'with' 'InjR' x1 => e1 | 'InjL' x2 => e2 'end'" := + (Match e0 x2 e2 x1 e1) + (e0, x1, e1, x2, e2 at level 200) : expr_scope. Notation "()" := LitUnit : val_scope. Notation "! e" := (Load e%E) (at level 9, right associativity) : expr_scope. Notation "'ref' e" := (Alloc e%E) diff --git a/heap_lang/substitution.v b/heap_lang/substitution.v index 0f1035b1f..7f854cbb4 100644 --- a/heap_lang/substitution.v +++ b/heap_lang/substitution.v @@ -78,7 +78,7 @@ Global Instance do_wexpr_store e1 e2 e1r e2r : W e1 e1r → W e2 e2r → W (Store e1 e2) (Store e1r e2r). Proof. by intros; red; f_equal/=. Qed. Global Instance do_wexpr_cas e0 e1 e2 e0r e1r e2r : - W e0 e0r → W e1 e1r → W e2 e2r → W (Cas e0 e1 e2) (Cas e0r e1r e2r). + W e0 e0r → W e1 e1r → W e2 e2r → W (CAS e0 e1 e2) (CAS e0r e1r e2r). Proof. by intros; red; f_equal/=. Qed. End do_wexpr. @@ -185,7 +185,7 @@ Global Instance do_wsubst_store e1 e2 e1r e2r : Sub e1 e1r → Sub e2 e2r → Sub (Store e1 e2) (Store e1r e2r). Proof. by intros; red; f_equal/=. Qed. Global Instance do_wsubst_cas e0 e1 e2 e0r e1r e2r : - Sub e0 e0r → Sub e1 e1r → Sub e2 e2r → Sub (Cas e0 e1 e2) (Cas e0r e1r e2r). + Sub e0 e0r → Sub e1 e1r → Sub e2 e2r → Sub (CAS e0 e1 e2) (CAS e0r e1r e2r). Proof. by intros; red; f_equal/=. Qed. End wsubst. diff --git a/heap_lang/tactics.v b/heap_lang/tactics.v index 7eae3f631..441e59614 100644 --- a/heap_lang/tactics.v +++ b/heap_lang/tactics.v @@ -66,10 +66,10 @@ Ltac reshape_expr e tac := | Load ?e => go (LoadCtx :: K) e | Store ?e1 ?e2 => reshape_val e1 ltac:(fun v1 => go (StoreRCtx v1 :: K) e2) | Store ?e1 ?e2 => go (StoreLCtx e2 :: K) e1 - | Cas ?e0 ?e1 ?e2 => reshape_val e0 ltac:(fun v0 => first + | CAS ?e0 ?e1 ?e2 => reshape_val e0 ltac:(fun v0 => first [ reshape_val e1 ltac:(fun v1 => go (CasRCtx v0 v1 :: K) e2) | go (CasMCtx v0 e2 :: K) e1 ]) - | Cas ?e0 ?e1 ?e2 => go (CasLCtx e1 e2 :: K) e0 + | CAS ?e0 ?e1 ?e2 => go (CasLCtx e1 e2 :: K) e0 end in go (@nil ectx_item) e. (** The tactic [do_step tac] solves goals of the shape [reducible], [prim_step] -- GitLab