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" <>,
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 *)
Definition CG_snap : val := λ: "st" "l" <>,
......@@ -66,7 +66,7 @@ Definition CG_stack : val :=
CG_stack_body "st" "l".
Section CG_Stack.
Context `{heapIG Σ, cfgSG Σ}.
Context `{logrelG Σ}.
Lemma CG_push_type Γ τ :
typed Γ CG_push (TArrow (Tref (CG_StackType τ)) (TArrow τ TUnit)).
......
......@@ -10,7 +10,7 @@ Notation Nile := (Fold (Alloc (InjL Unit))).
Definition FG_push : val := rec: "push" "st" := λ: "x",
let: "stv" := !"st" in
if: (CAS "st" "stv" (Conse "x" "stv"))
then #()
then ()
else "push" "st" "x".
......@@ -28,11 +28,11 @@ Definition FG_pop : val := rec: "pop" "st" := λ: <>,
let: "stv" := !"st" in
let: "x" := !(Unfold "stv") in
case: "x" of
InjL => λ: <>, InjL #()
InjL => λ: <>, InjL ()
| InjR => λ: "x", let: "y" := Fst "x" in let: "ys" := Snd "x" in
if: (CAS "st" "stv" "ys")
then (InjR "y")
else "pop" "st" #()
else "pop" "st" ()
end.
(* iter f = λ st.
......@@ -41,7 +41,7 @@ Definition FG_pop : val := rec: "pop" "st" := λ: <>,
| cons y ys => f y ;; iter f ys *)
Definition FG_iter : val := rec: "iter" "f" := λ: "st",
case: !(Unfold "st") of
InjL => λ: <>, #()
InjL => λ: <>, ()
| InjR => λ: "x",
let: "y" := Fst "x" in
let: "ys" := Snd "x" in
......
This diff is collapsed.
......@@ -45,7 +45,7 @@ Section Rules.
stacklink Q (z1, z2) }*)
Program Definition StackLink_pre (Q : D) : D -n> D := λne P v,
( 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))
v.2 = FoldV (InjRV (PairV y2 z2)) Q (y1, y2) P(z1, z2))))%I.
Solve Obligations with solve_proper.
......@@ -58,7 +58,7 @@ Section Rules.
Lemma StackLink_unfold Q v :
StackLink Q v ( 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))
v.2 = FoldV (InjRV (PairV y2 z2))
Q (y1, y2) StackLink Q (z1, z2))))%I.
......@@ -84,7 +84,7 @@ Section Rules.
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.
Context `{heapIG Σ}.
Context `{logrelG Σ}.
Definition stack_owns (h : stackUR) : iProp Σ :=
(own stack_name ( h)
......@@ -116,7 +116,7 @@ Section Rules.
iDestruct (own_valid_2 with "Howns Hl")
as %[[av' [Hl Hav']]%singleton_included ?]%auth_valid_discrete_2.
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.
assert (v = v') as <-.
{ apply Some_included in Hav'.
......
......@@ -29,8 +29,8 @@ F_mu_ref_conc/examples/counter.v
F_mu_ref_conc/examples/lateearlychoice.v
F_mu_ref_conc/examples/par.v
F_mu_ref_conc/examples/bit.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/FG_stack.v
#F_mu_ref_conc/examples/stack/refinement.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/FG_stack.v
F_mu_ref_conc/examples/stack/refinement.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