Commit 2961c9a7 authored by Dan Frumin's avatar Dan Frumin

Port the stack refinement example

parent ef040112
...@@ -30,7 +30,7 @@ Definition CG_pop : val := λ: "st" <>, ...@@ -30,7 +30,7 @@ Definition CG_pop : val := λ: "st" <>,
Definition CG_locked_pop : val := λ: "st" "l" <>, Definition CG_locked_pop : val := λ: "st" "l" <>,
acquire "l";; (let: "v" := CG_pop "st" #() in (release "l";; "v")). acquire "l";; (let: "v" := CG_pop "st" () in (release "l";; "v")).
(* snap st l = with_lock (λ _, load st) l *) (* snap st l = with_lock (λ _, load st) l *)
Definition CG_snap : val := λ: "st" "l" <>, Definition CG_snap : val := λ: "st" "l" <>,
...@@ -66,7 +66,7 @@ Definition CG_stack : val := ...@@ -66,7 +66,7 @@ Definition CG_stack : val :=
CG_stack_body "st" "l". CG_stack_body "st" "l".
Section CG_Stack. Section CG_Stack.
Context `{heapIG Σ, cfgSG Σ}. Context `{logrelG Σ}.
Lemma CG_push_type Γ τ : Lemma CG_push_type Γ τ :
typed Γ CG_push (TArrow (Tref (CG_StackType τ)) (TArrow τ TUnit)). typed Γ CG_push (TArrow (Tref (CG_StackType τ)) (TArrow τ TUnit)).
......
...@@ -10,7 +10,7 @@ Notation Nile := (Fold (Alloc (InjL Unit))). ...@@ -10,7 +10,7 @@ Notation Nile := (Fold (Alloc (InjL Unit))).
Definition FG_push : val := rec: "push" "st" := λ: "x", Definition FG_push : val := rec: "push" "st" := λ: "x",
let: "stv" := !"st" in let: "stv" := !"st" in
if: (CAS "st" "stv" (Conse "x" "stv")) if: (CAS "st" "stv" (Conse "x" "stv"))
then #() then ()
else "push" "st" "x". else "push" "st" "x".
...@@ -28,11 +28,11 @@ Definition FG_pop : val := rec: "pop" "st" := λ: <>, ...@@ -28,11 +28,11 @@ Definition FG_pop : val := rec: "pop" "st" := λ: <>,
let: "stv" := !"st" in let: "stv" := !"st" in
let: "x" := !(Unfold "stv") in let: "x" := !(Unfold "stv") in
case: "x" of case: "x" of
InjL => λ: <>, InjL #() InjL => λ: <>, InjL ()
| InjR => λ: "x", let: "y" := Fst "x" in let: "ys" := Snd "x" in | InjR => λ: "x", let: "y" := Fst "x" in let: "ys" := Snd "x" in
if: (CAS "st" "stv" "ys") if: (CAS "st" "stv" "ys")
then (InjR "y") then (InjR "y")
else "pop" "st" #() else "pop" "st" ()
end. end.
(* iter f = λ st. (* iter f = λ st.
...@@ -41,7 +41,7 @@ Definition FG_pop : val := rec: "pop" "st" := λ: <>, ...@@ -41,7 +41,7 @@ Definition FG_pop : val := rec: "pop" "st" := λ: <>,
| cons y ys => f y ;; iter f ys *) | cons y ys => f y ;; iter f ys *)
Definition FG_iter : val := rec: "iter" "f" := λ: "st", Definition FG_iter : val := rec: "iter" "f" := λ: "st",
case: !(Unfold "st") of case: !(Unfold "st") of
InjL => λ: <>, #() InjL => λ: <>, ()
| InjR => λ: "x", | InjR => λ: "x",
let: "y" := Fst "x" in let: "y" := Fst "x" in
let: "ys" := Snd "x" in let: "ys" := Snd "x" in
......
This diff is collapsed.
...@@ -45,7 +45,7 @@ Section Rules. ...@@ -45,7 +45,7 @@ Section Rules.
stacklink Q (z1, z2) }*) stacklink Q (z1, z2) }*)
Program Definition StackLink_pre (Q : D) : D -n> D := λne P v, Program Definition StackLink_pre (Q : D) : D -n> D := λne P v,
( l w, v.1 = LocV l l ↦ˢᵗᵏ w ( l w, v.1 = LocV l l ↦ˢᵗᵏ w
((w = InjLV UnitV v.2 = FoldV (InjLV UnitV)) ((w = InjLV (LitV tt) v.2 = FoldV (InjLV (LitV tt)))
( y1 z1 y2 z2, w = InjRV (PairV y1 (FoldV z1)) ( y1 z1 y2 z2, w = InjRV (PairV y1 (FoldV z1))
v.2 = FoldV (InjRV (PairV y2 z2)) Q (y1, y2) P(z1, z2))))%I. v.2 = FoldV (InjRV (PairV y2 z2)) Q (y1, y2) P(z1, z2))))%I.
Solve Obligations with solve_proper. Solve Obligations with solve_proper.
...@@ -58,7 +58,7 @@ Section Rules. ...@@ -58,7 +58,7 @@ Section Rules.
Lemma StackLink_unfold Q v : Lemma StackLink_unfold Q v :
StackLink Q v ( l w, StackLink Q v ( l w,
v.1 = LocV l l ↦ˢᵗᵏ w v.1 = LocV l l ↦ˢᵗᵏ w
((w = InjLV UnitV v.2 = FoldV (InjLV UnitV)) ((w = InjLV (LitV tt) v.2 = FoldV (InjLV (LitV tt)))
( y1 z1 y2 z2, w = InjRV (PairV y1 (FoldV z1)) ( y1 z1 y2 z2, w = InjRV (PairV y1 (FoldV z1))
v.2 = FoldV (InjRV (PairV y2 z2)) v.2 = FoldV (InjRV (PairV y2 z2))
Q (y1, y2) StackLink Q (z1, z2))))%I. Q (y1, y2) StackLink Q (z1, z2))))%I.
...@@ -84,7 +84,7 @@ Section Rules. ...@@ -84,7 +84,7 @@ Section Rules.
h !! i = None h ~~> (<[i := to_agree v]> h) {[i := to_agree v]}. h !! i = None h ~~> (<[i := to_agree v]> h) {[i := to_agree v]}.
Proof. intros. by apply auth_update_alloc, alloc_singleton_local_update. Qed. Proof. intros. by apply auth_update_alloc, alloc_singleton_local_update. Qed.
Context `{heapIG Σ}. Context `{logrelG Σ}.
Definition stack_owns (h : stackUR) : iProp Σ := Definition stack_owns (h : stackUR) : iProp Σ :=
(own stack_name ( h) (own stack_name ( h)
...@@ -116,7 +116,7 @@ Section Rules. ...@@ -116,7 +116,7 @@ Section Rules.
iDestruct (own_valid_2 with "Howns Hl") iDestruct (own_valid_2 with "Howns Hl")
as %[[av' [Hl Hav']]%singleton_included ?]%auth_valid_discrete_2. as %[[av' [Hl Hav']]%singleton_included ?]%auth_valid_discrete_2.
eapply leibniz_equiv in Hl. eapply leibniz_equiv in Hl.
iDestruct (big_sepM_lookup_acc with "Hls") as "[Hl' Hclose]"; first done. iDestruct (big_sepM_lookup_acc with "Hls") as "[Hl' Hclose]"; first done.
destruct av' as [[|v' av'] ?]; first by iExFalso. simpl. destruct av' as [[|v' av'] ?]; first by iExFalso. simpl.
assert (v = v') as <-. assert (v = v') as <-.
{ apply Some_included in Hav'. { apply Some_included in Hav'.
......
...@@ -29,8 +29,8 @@ F_mu_ref_conc/examples/counter.v ...@@ -29,8 +29,8 @@ F_mu_ref_conc/examples/counter.v
F_mu_ref_conc/examples/lateearlychoice.v F_mu_ref_conc/examples/lateearlychoice.v
F_mu_ref_conc/examples/par.v F_mu_ref_conc/examples/par.v
F_mu_ref_conc/examples/bit.v F_mu_ref_conc/examples/bit.v
#F_mu_ref_conc/examples/stack/stack_rules.v F_mu_ref_conc/examples/stack/stack_rules.v
#F_mu_ref_conc/examples/stack/CG_stack.v F_mu_ref_conc/examples/stack/CG_stack.v
#F_mu_ref_conc/examples/stack/FG_stack.v F_mu_ref_conc/examples/stack/FG_stack.v
#F_mu_ref_conc/examples/stack/refinement.v F_mu_ref_conc/examples/stack/refinement.v
F_mu_ref_conc/examples/typetest.v F_mu_ref_conc/examples/typetest.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