Commit 3ae7284d by Marianna Rapoport

### Adding support for prophecy resolution to heap_lang.CAS

parent fb2b152a
 ... ... @@ -116,7 +116,7 @@ Section tests. Lemma wp_cas l v : val_is_unboxed v → l ↦ v -∗ WP CAS #l v v {{ _, True }}. l ↦ v -∗ WP cas: #l, v, v {{ _, True }}. Proof. iIntros (?) "?". wp_cas as ? | ?. done. done. Qed. ... ...
 ... ... @@ -121,7 +121,7 @@ Definition newcounter : val := λ: <>, ref #0. Definition incr : val := rec: "incr" "l" := let: "n" := !"l" in if: CAS "l" "n" (#1 + "n") then #() else "incr" "l". if: cas: "l", "n", #1 + "n" then #() else "incr" "l". Definition read : val := λ: "l", !"l". (** The CMRA we need. *) ... ... @@ -222,7 +222,7 @@ Section counter_proof. iDestruct 1 as (c) "[Hl Hγ]". wp_load. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. wp_let. wp_op. wp_bind (CAS _ _ _). iApply wp_inv_open; last iFrame "Hinv"; auto. wp_bind (cas: _, _, _)%E. iApply wp_inv_open; last iFrame "Hinv"; auto. iDestruct 1 as (c') ">[Hl Hγ]". destruct (decide (c' = c)) as [->|]. - iCombine "Hγ" "Hγf" as "Hγ". ... ...
 ... ... @@ -8,7 +8,7 @@ Set Default Proof Using "Type". Definition one_shot_example : val := λ: <>, let: "x" := ref NONE in ( (* tryset *) (λ: "n", CAS "x" NONE (SOME "n")), cas: "x", NONE, SOME "n"), (* check *) (λ: <>, let: "y" := !"x" in λ: <>, match: "y" with ... ...
 ... ... @@ -83,7 +83,7 @@ Inductive expr := | Alloc (e : expr) | Load (e : expr) | Store (e1 : expr) (e2 : expr) | CAS (e0 : expr) (e1 : expr) (e2 : expr) | CAS (e0 : expr) (e1 : expr) (e2 : expr) (e3 : expr) (e4 : expr) | FAA (e1 : expr) (e2 : expr) (* Prophecy *) | NewProph ... ... @@ -190,8 +190,9 @@ Proof. | Load e, Load e' => cast_if (decide (e = e')) | Store e1 e2, Store e1' e2' => cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) | CAS e0 e1 e2, CAS e0' e1' e2' => cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2')) | CAS e0 e1 e2 e3 e4, CAS e0' e1' e2' e3' e4' => cast_if_and5 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2')) (decide (e3 = e3')) (decide (e4 = e4')) | FAA e1 e2, FAA e1' e2' => cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) | NewProph, NewProph => left _ ... ... @@ -251,7 +252,7 @@ Proof. Qed. Instance expr_countable : Countable expr. Proof. set (enc := set (enc := fix go e := match e with | Val v => GenNode 0 [gov v] ... ... @@ -271,7 +272,7 @@ Proof. | Alloc e => GenNode 13 [go e] | Load e => GenNode 14 [go e] | Store e1 e2 => GenNode 15 [go e1; go e2] | CAS e0 e1 e2 => GenNode 16 [go e0; go e1; go e2] | CAS e0 e1 e2 e3 e4 => GenNode 16 [go e0; go e1; go e2; go e3; go e4] | FAA e1 e2 => GenNode 17 [go e1; go e2] | NewProph => GenNode 18 [] | ResolveProph e1 e2 => GenNode 19 [go e1; go e2] ... ... @@ -306,7 +307,7 @@ Proof. | GenNode 13 [e] => Alloc (go e) | GenNode 14 [e] => Load (go e) | GenNode 15 [e1; e2] => Store (go e1) (go e2) | GenNode 16 [e0; e1; e2] => CAS (go e0) (go e1) (go e2) | GenNode 16 [e0; e1; e2; e3; e4] => CAS (go e0) (go e1) (go e2) (go e3) (go e4) | GenNode 17 [e1; e2] => FAA (go e1) (go e2) | GenNode 18 [] => NewProph | GenNode 19 [e1; e2] => ResolveProph (go e1) (go e2) ... ... @@ -359,9 +360,11 @@ Inductive ectx_item := | LoadCtx | StoreLCtx (v2 : val) | StoreRCtx (e1 : expr) | CasLCtx (v1 : val) (v2 : val) | CasMCtx (e0 : expr) (v2 : val) | CasRCtx (e0 : expr) (e1 : expr) | CasLCtx (v1 : val) (v2 : val) (v3 : val) (v4 : val) | CasM1Ctx (e0 : expr) (v2 : val) (v3 : val) (v4 : val) | CasM2Ctx (e0 : expr) (e1 : expr) (v3 : val) (v4 : val) | CasM3Ctx (e0 : expr) (e1 : expr) (e2 : expr) (v4 : val) | CasRCtx (e0 : expr) (e1 : expr) (e2 : expr) (e3 : expr) | FaaLCtx (v2 : val) | FaaRCtx (e1 : expr) | ProphLCtx (v2 : val) ... ... @@ -386,9 +389,11 @@ Definition fill_item (Ki : ectx_item) (e : expr) : expr := | LoadCtx => Load e | StoreLCtx v2 => Store e (Val v2) | StoreRCtx e1 => Store e1 e | CasLCtx v1 v2 => CAS e (Val v1) (Val v2) | CasMCtx e0 v2 => CAS e0 e (Val v2) | CasRCtx e0 e1 => CAS e0 e1 e | CasLCtx v1 v2 v3 v4 => CAS e (Val v1) (Val v2) (Val v3) (Val v4) | CasM1Ctx e0 v2 v3 v4 => CAS e0 e (Val v2) (Val v3) (Val v4) | CasM2Ctx e0 e1 v3 v4 => CAS e0 e1 e (Val v3) (Val v4) | CasM3Ctx e0 e1 e2 v4 => CAS e0 e1 e2 e (Val v4) | CasRCtx e0 e1 e2 e3 => CAS e0 e1 e2 e3 e | FaaLCtx v2 => FAA e (Val v2) | FaaRCtx e1 => FAA e1 e | ProphLCtx v2 => ResolveProph e (of_val v2) ... ... @@ -416,7 +421,7 @@ Fixpoint subst (x : string) (v : val) (e : expr) : expr := | Alloc e => Alloc (subst x v e) | Load e => Load (subst x v e) | Store e1 e2 => Store (subst x v e1) (subst x v e2) | CAS e0 e1 e2 => CAS (subst x v e0) (subst x v e1) (subst x v e2) | CAS e0 e1 e2 e3 e4 => CAS (subst x v e0) (subst x v e1) (subst x v e2) (subst x v e3) (subst x v e4) | FAA e1 e2 => FAA (subst x v e1) (subst x v e2) | NewProph => NewProph | ResolveProph e1 e2 => ResolveProph (subst x v e1) (subst x v e2) ... ... @@ -485,6 +490,31 @@ Definition state_upd_used_proph_id (f: gset proph_id → gset proph_id) (σ: sta {| heap := σ.(heap); used_proph_id := f σ.(used_proph_id) |}. Arguments state_upd_used_proph_id _ !_ /. (** We extend CAS to support atomic resolution of prophecy variables as follows: [CAS p e1 e1 pv1 pv2] where [pv1] and [pv2] are values of type [option (proph * val)]. If [CAS p e1 e2] succeeds, and if [pv1 = Some (p, v)], we atomically resolve the prophecy variable [p] to [v]. If the [CAS] fails, we do the same of [pv2]: [let b = CAS p e1 e2 ;; match (if b then pv1 else pv2) with | Some (p, v) => resolve p to v | None => () end] The following function takes a value and extracts its encoding of an optional prophecy-value pair. *) Definition extract_proph_resolve (v : val) : option (option (proph_id * val)) := match v with | InjLV (LitV LitUnit) => Some None | InjRV (PairV (LitV (LitProphecy p)) v') => Some (Some (p, v')) | _ => None end. Inductive head_step : expr → state → list observation → expr → state → list (expr) → Prop := | RecS f x e σ : head_step (Rec f x e) σ [] (Val \$ RecV f x e) σ [] ... ... @@ -532,16 +562,22 @@ Inductive head_step : expr → state → list observation → expr → state → [] (Val \$ LitV LitUnit) (state_upd_heap <[l:=v]> σ) [] | CasFailS l v1 v2 vl σ : | CasFailS l v1 v2 v3 v4 pv pvs vl σ : extract_proph_resolve v4 = Some pv → pvs = option_list pv → σ.(heap) !! l = Some vl → vl ≠ v1 → vals_cas_compare_safe vl v1 → head_step (CAS (Val \$ LitV \$ LitLoc l) (Val v1) (Val v2)) σ [] (Val \$ LitV \$ LitBool false) σ [] | CasSucS l v1 v2 σ : head_step (CAS (Val \$ LitV \$ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4)) σ pvs (Val \$ LitV \$ LitBool false) σ [] | CasSucS l v1 v2 v3 v4 pv pvs σ : extract_proph_resolve v3 = Some pv → pvs = option_list pv → σ.(heap) !! l = Some v1 → vals_cas_compare_safe v1 v1 → head_step (CAS (Val \$ LitV \$ LitLoc l) (Val v1) (Val v2)) σ [] head_step (CAS (Val \$ LitV \$ LitLoc l) (Val v1) (Val v2) (Val v3) (Val v4)) σ pvs (Val \$ LitV \$ LitBool true) (state_upd_heap <[l:=v2]> σ) [] | FaaS l i1 i2 σ : ... ...
 ... ... @@ -32,11 +32,23 @@ Class atomic_heap {Σ} `{!heapG Σ} := AtomicHeap { *or* [v] to be unboxed. However, by writing it this way the [val_is_unboxed] is outside the atomic triple, which makes it much easier to use -- and the spec is still good enough for all our applications. *) cas_spec (l : loc) (w1 w2 : val) : cas_spec (l : loc) (w1 w2 w3 w4 : val) : extract_proph_resolve w3 = Some None → extract_proph_resolve w4 = Some None → val_is_unboxed w1 → <<< ∀ v, mapsto l 1 v >>> cas #l w1 w2 @ ⊤ <<< ∀ v, mapsto l 1 v >>> cas #l w1 w2 w3 w4 @ ⊤ <<< if decide (v = w1) then mapsto l 1 w2 else mapsto l 1 v, RET #(if decide (v = w1) then true else false) >>>; RET #(if decide (v = w1) then true else false) >>>; cas_suc_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) : extract_proph_resolve w3 = Some (Some (p, w)) → val_is_unboxed w1 → <<< mapsto l 1 w1 ∗ proph p v >>> cas #l w1 w2 w3 w4 @ ⊤ <<< mapsto l 1 w2 ∗ ⌜v = Some w⌝, RET #true>>>; cas_fail_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) : extract_proph_resolve w4 = Some (Some (p, w)) → val_is_unboxed w1 → <<< ∀ v', ⌜v' ≠ w1⌝ ∗ mapsto l 1 v' ∗ proph p v >>> cas #l w1 w2 w3 w4 @ ⊤ <<< mapsto l 1 v' ∗ ⌜v = Some w⌝, RET #false>>>; }. Arguments atomic_heap _ {_}. ... ... @@ -54,7 +66,7 @@ Notation "'ref' e" := (alloc e) : expr_scope. Notation "! e" := (load e) : expr_scope. Notation "e1 <- e2" := (store e1 e2) : expr_scope. Notation CAS e1 e2 e3 := (cas e1 e2 e3). Notation CAS e1 e2 e3 e4 e5 := (cas e1 e2 e3 e4 e5). End notation. ... ... @@ -66,7 +78,7 @@ Definition primitive_load : val := Definition primitive_store : val := λ: "l" "x", "l" <- "x". Definition primitive_cas : val := λ: "l" "e1" "e2", CAS "l" "e1" "e2". λ: "l" "e1" "e2" "e3" "e4", CAS "l" "e1" "e2" "e3" "e4". Section proof. Context `{!heapG Σ}. ... ... @@ -95,18 +107,46 @@ Section proof. wp_store. iMod ("Hclose" with "H↦") as "HΦ". by iApply "HΦ". Qed. Lemma primitive_cas_spec (l : loc) (w1 w2 : val) : Lemma primitive_cas_spec (l : loc) (w1 w2 w3 w4: val) : extract_proph_resolve w3 = Some None → extract_proph_resolve w4 = Some None → val_is_unboxed w1 → <<< ∀ (v : val), l ↦ v >>> primitive_cas #l w1 w2 @ ⊤ primitive_cas #l w1 w2 w3 w4 @ ⊤ <<< if decide (v = w1) then l ↦ w2 else l ↦ v, RET #(if decide (v = w1) then true else false) >>>. Proof. iIntros (? Q Φ) "? AU". wp_lam. wp_let. wp_let. iIntros (??? Q Φ) "? AU". wp_lam. repeat wp_let. iMod "AU" as (v) "[H↦ [_ Hclose]]". destruct (decide (v = w1)) as [<-|Hv]; [wp_cas_suc|wp_cas_fail]; iMod ("Hclose" with "H↦") as "HΦ"; by iApply "HΦ". Qed. Lemma primitive_cas_suc_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) : extract_proph_resolve w3 = Some (Some (p, w)) → val_is_unboxed w1 → <<< l ↦ w1 ∗ proph p v >>> primitive_cas #l w1 w2 w3 w4 @ ⊤ <<< l ↦ w2 ∗ ⌜v = Some w⌝, RET #true>>>. Proof. iIntros (?? Q Φ) "? AU". wp_lam. repeat wp_let. iMod "AU" as "[[H↦ Hp] [_ Hclose]]". wp_apply (wp_cas_suc_proph with "[H↦ Hp]"); eauto with iFrame; first by left. iIntros "H". iMod ("Hclose" with "H") as "HΦ". by iApply "HΦ". Qed. Lemma primitive_cas_fail_proph_spec (l : loc) (w1 w2 w3 w4 w : val) v (p : proph_id) : extract_proph_resolve w4 = Some (Some (p, w)) → val_is_unboxed w1 → <<< ∀ v', ⌜v' ≠ w1⌝ ∗ l ↦ v' ∗ proph p v >>> primitive_cas #l w1 w2 w3 w4 @ ⊤ <<< l ↦ v' ∗ ⌜v = Some w⌝, RET #false>>>. Proof. iIntros (? ? Q Φ) "? AU". wp_lam. repeat wp_let. iMod "AU" as (v') "[(Hn & H↦ & Hp) [_ Hclose]]". iDestruct "Hn" as %Hn. wp_apply (wp_cas_fail_proph with "[H↦ Hp]"); eauto with iFrame; first by right. iIntros "H". iMod ("Hclose" with "H") as "HΦ". by iApply "HΦ". Qed. End proof. (* NOT an instance because users should choose explicitly to use it ... ... @@ -116,4 +156,6 @@ Definition primitive_atomic_heap `{!heapG Σ} : atomic_heap Σ := load_spec := primitive_load_spec; store_spec := primitive_store_spec; cas_spec := primitive_cas_spec; mapsto_agree := gen_heap.mapsto_agree |}. cas_suc_proph_spec := primitive_cas_suc_proph_spec; cas_fail_proph_spec := primitive_cas_fail_proph_spec; mapsto_agree := gen_heap.mapsto_agree |}.