Set Bullet Behavior "Strict Subproofs".
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.
Definition load_SC_spec := DECLARE _load_SC load_SC_spec.
Definition store_SC_spec := DECLARE _store_SC store_SC_spec.
Definition tnode := Tstruct _node noattr.
Opaque upto.
Existing Instances map_PCM fmap_order.
Definition ghost_log := ghost_master (ORD := @fmap_order nat Z).
Definition ghost_lsnap := ghost_snap (ORD := @fmap_order nat Z).
Definition ghost_version := ghost_master (ORD := max_order).
Definition ghost_vsnap := ghost_snap (ORD := max_order).
Definition node_entry sh v vs locs lg i := EX v' : nat, EX log : nat -> option Z, EX d : Z,
!!(repable_signed d /\ (if Nat.even v then v' = v /\ d = Znth i vs else (v' >= v - 1)%nat) /\ log_latest log v' d) &&
ghost_log sh log (Znth i lg) * data_at sh tint (vint d) (Znth i locs).
Existing Instances nat_PCM max_order.
Definition node_state sh v vs version locs g lg := !!(repable_signed (Z.of_nat v) /\
Forall repable_signed vs /\ Zlength vs = Zlength locs /\ Zlength lg = Zlength locs) &&
ghost_version sh v g * data_at sh tint (vint (Z.of_nat v)) version *
fold_right sepcon emp (map (node_entry sh v vs locs lg) (upto (length locs))).
Definition node_inv v vs version locs g lg := EX v' : nat, !!(Nat.even v = true /\ (v' = v \/ v' = v + 1)%nat) &&
node_state gsh2 v' vs version locs g lg.
Program Definition read_spec := DECLARE _read atomic_spec
(ConstType (val * val * share * val * list val * gname * list gname * nat * list Z))
[(_n, tptr tnode); (_out, tptr tint)] tvoid
[fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) => temp _n n;
fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) => temp _out out]
(fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) => !!(readable_share sh /\ isptr version /\
Forall isptr locs /\ Zlength locs = 8) &&
data_at sh tnode (version, locs) n * data_at_ Tsh (tarray tint 8) out)
(fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) '(v, vs) => node_inv v vs version locs g lg)
tt []
(fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) '(v, vs) _ =>
data_at sh tnode (version, locs) n * data_at Tsh (tarray tint 8) (map (fun x => vint x) vs) out *
node_inv v vs version locs g lg)
(Empty_set _) (Full_set _) _ _ _ _ _.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
(* The gsh1 share of the node state acts as the write permission. *)
Program Definition write_spec := DECLARE _write atomic_spec
(ConstType (val * val * share * val * list val * list Z * gname * list gname * nat * list Z))
[(_n, tptr tnode); (_in, tptr tint)] tvoid
[fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) => temp _n n;
fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) => temp _in input]
(fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) => !!(readable_share sh /\ isptr version /\
Forall isptr locs /\ Zlength locs = 8 /\ Forall repable_signed vals /\ Nat.even v0 = true) &&
data_at sh tnode (version, locs) n * data_at Tsh (tarray tint 8) (map (fun x => vint x) vals) input *
node_state gsh1 v0 vs0 version locs g lg)
(fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) '(v, vs) => node_inv v vs version locs g lg)
tt []
(fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) '(v, vs) _ =>
data_at sh tnode (version, locs) n * data_at Tsh (tarray tint 8) (map (fun x => vint x) vals) input *
node_state gsh1 (v0 + 2) vals version locs g lg * node_inv (v0 + 2) vals version locs g lg)
(Empty_set _) (Full_set _) _ _ _ _ _.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Definition Gprog : funspecs := ltac:(with_library prog [load_SC_spec; store_SC_spec; read_spec; write_spec]).

Lemma clean_entry : forall v vs locs lg i vs', Nat.even v = false ->
node_entry gsh1 (v + 1) vs' locs lg i * node_entry gsh2 v vs locs lg i |--
node_entry gsh1 (v + 1) vs' locs lg i * node_entry gsh2 (v + 1) vs' locs lg i.