(* The collection of protocol assertions that describes a stable state of the node. *)
Definition node_state (sh : share) (L : Z -> option (list Z)) v version locs g :=
!!(Z.even v = true /\ 0 <= v /\ exists vs, Zlength vs = size /\ log_latest L v vs) &&
protocol_piece sh version v Z.le (version_T version locs g, version_T version locs g) *
fold_right sepcon emp (map (fun i => protocol_piece sh (Znth i locs Vundef) (map_Znth i L 0) map_incl
(data_T version locs g, data_T version locs g)) (upto (Z.to_nat size))) * ghost (sh, L) g.
Program Definition read_spec := DECLARE _read atomic_spec
(ConstType (val * val * share * share * val * list val * val * (Z -> option (list Z)) * Z))
empty_map [(_n, tptr tnode); (_out, tptr tint)] tvoid
[fun _ '(n, out, sh, shi, version, locs, g, L0, v0) => temp _n n;
fun _ '(n, out, sh, shi, version, locs, g, L0, v0) => temp _out out]
(fun _ '(n, out, sh, shi, version, locs, g, L0, v0) => !!(readable_share sh /\
writable_share shi /\ isptr version /\ Forall isptr locs /\ Zlength locs = size) &&
data_at sh tnode (version, locs) n * data_at_ shi (tarray tint size) out *
node_state Share.bot L0 v0 version locs g)
(fun _ '(n, out, sh, shi, version, locs, g, L0, v0) L => ghost (gsh1, L) g)
(0, []) []
(fun _ '(n, out, sh, shi, version, locs, g, L0, v0) L '(v, vals) =>
!!(v0 <= v /\ Zlength vals = size) &&
data_at sh tnode (version, locs) n * data_at shi (tarray tint size) (map (fun x => vint x) vals) out *
node_state Share.bot (map_upd L0 v vals) v version locs g)
(fun _ '(n, out, sh, shi, version, locs, g, L0, v0) L '(v, vals) => !!(map_incl L0 L /\ L v = Some vals) &&
ghost (gsh1, L) g)
_ _ _ _ _ _.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
(* Because the "actual state" of the structure is divided between the writer and the invariant, a writer can make arbitrary updates to the ghost state and the data (without calling write). However, the protocols and the PCM constrain the nature of those updates to the sort of changes we'd expect anyway. *)
Program Definition write_spec := DECLARE _write atomic_spec
(ConstType (val * val * share * share * val * list val * list Z * val * (Z -> option (list Z)) * Z))
(@empty_map Z (list Z)) [(_n, tptr tnode); (_in, tptr tint)] tvoid
[fun _ '(n, input, sh, shi, version, locs, vals, g, L, v0) => temp _n n;
fun _ '(n, input, sh, shi, version, locs, vals, g, L, v0) => temp _in input]
(fun _ '(n, input, sh, shi, version, locs, vals, g, L, v0) => !!(readable_share sh /\
readable_share shi /\ isptr version /\ Forall isptr locs /\ Zlength locs = size /\
Forall repable_signed vals /\ repable_signed (v0 + 2)) &&
data_at sh tnode (version, locs) n * data_at shi (tarray tint size) (map (fun x => vint x) vals) input *
node_state gsh2 L v0 version locs g)
(fun _ '(n, input, sh, shi, version, locs, vals, g, L, v0) L' => ghost (gsh1, L') g)
tt []
(fun _ '(n, input, sh, shi, version, locs, vals, g, L, v0) _ _ =>
data_at sh tnode (version, locs) n * data_at shi (tarray tint size) (map (fun x => vint x) vals) input *
node_state gsh2 (map_upd L (v0 + 2) vals) (v0 + 2) version locs g)
(fun _ '(n, input, sh, shi, version, locs, vals, g, L, v0) _ _ => ghost (gsh1, map_upd L (v0 + 2) vals) g)
_ _ _ _ _ _.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Definition make_node_spec := DECLARE _make_node
WITH u : unit
PRE [ ]
PROP ()
LOCAL ()
SEP ()
POST [ tptr tnode ]
EX n : val, EX version : val, EX locs : list val, EX g : val,
PROP (isptr version; Forall isptr locs; Zlength locs = size)
LOCAL (temp ret_temp n)
SEP (data_at Tsh tnode (version, locs) n; malloc_token Tsh (sizeof tnode) n;
malloc_token Tsh (sizeof tint) version; fold_right sepcon emp (map (malloc_token Tsh (sizeof tint)) locs);
node_state gsh2 (singleton 0 (repeat 0 (Z.to_nat size))) 0 version locs g;
ghost (gsh1, singleton 0 (repeat 0 (Z.to_nat size))) g).
Definition writer_spec := DECLARE _writer
WITH n : val, sh : share, v : Z, L : Z -> option (list Z), version : val, locs : list val, g : val
PRE [ _n OF tptr tvoid ]
PROP (readable_share sh; isptr version; Forall isptr locs; Zlength locs = size; repable_signed (v + 6))
LOCAL (temp _n n)
SEP (data_at sh tnode (version, locs) n; node_state gsh2 L v version locs g;
invariant (EX L : Z -> option (list Z), ghost (gsh1, L) g))
POST [ tptr tvoid ]
EX L' : _,
PROP (L' = map_upd_list L (map (fun i => (v + (2 * (i + 1)), repeat (i + 1) (Z.to_nat size)))%Z (upto 3)))
LOCAL ()
SEP (data_at sh tnode (version, locs) n; node_state gsh2 L' (v + 6) version locs g;
invariant (EX L : Z -> option (list Z), ghost (gsh1, L) g)).
(*Definition reader_spec := DECLARE _reader WITH n : val, sh : share, version : val, locs : list val, g : val, g' : val, lg : list val, lg' : list val, gh : val, gsh : share PRE [ _n OF tptr tvoid ] PROP (readable_share sh; isptr version; Forall isptr locs; Zlength locs = size; gsh <> Share.bot) LOCAL (temp _n n) SEP (data_at sh tnode (version, locs) n; ghost_hist gsh ([] : hist) gh; invariant (node_inv gh version locs g g' lg lg')) POST [ tptr tvoid ] EX h : hist, PROP (exists v vs, add_events [] [HRead v vs] h) LOCAL () SEP (data_at sh tnode (version, locs) n; ghost_hist gsh h gh; invariant (node_inv gh version locs g g' lg lg')).*)
(* We can't keep an interleaved history of reads and writes, but we can know that each read got a value that was at some point in the history. *)
(*Program Definition reader_spec := DECLARE _reader atomic_spec (ConstType (val * share * val * list val * val * val * list val * list val * val * share)) tt [(_n, tptr tvoid)] (tptr tvoid) [fun _ '(n, sh, version, locs, g, g', lg, lg', gh, gsh) => temp _n n] (fun _ '(n, sh, version, locs, g, g', lg, lg', gh, gsh) => !!(readable_share sh /\ isptr version /\ Forall isptr locs /\ Zlength locs = size /\ gsh <> Share.bot) && data_at sh tnode (version, locs) n) (fun _ '(n, sh, version, locs, g, g', lg, lg', gh, gsh) _ => node_inv gh version locs g g' lg lg') (0, []) [] (fun _ '(n, sh, version, locs, g, g', lg, lg', gh, gsh) _ _ => data_at sh tnode (version, locs) n) (fun _ '(n, sh, version, locs, g, g', lg, lg', gh, gsh) _ '(v1, vs1) => EX v : Z, EX vs : list Z, node_state v vs version locs g g' lg lg' * EX hr : _, !!(apply_hist (0, repeat 0 (Z.to_nat size)) hr = Some (v, vs) /\ In (HWrite v1 vs1) hr) && ghost_ref hr gh) _ _ _ _ _ _. (* We could encapsulate this with another argument to node_inv, a known sublist of hr. *)*)
Definition reader_spec := DECLARE _reader
WITH n : val, sh : share, v : Z, L : Z -> option (list Z), version : val, locs : list val, g : val
PRE [ _n OF tptr tvoid ]
PROP (readable_share sh; isptr version; Forall isptr locs; Zlength locs = size)
LOCAL (temp _n n)
SEP (data_at sh tnode (version, locs) n; node_state Share.bot L v version locs g;
invariant (EX L : Z -> option (list Z), ghost (gsh1, L) g))
POST [ tptr tvoid ]
EX v' : Z, EX vs' : list Z,
PROP (v <= v'; v' = v -> Z.even v = true /\ L v = Some vs')
LOCAL ()
SEP (data_at sh tnode (version, locs) n; node_state Share.bot (map_upd L v' vs') v' version locs g;
invariant (EX L : Z -> option (list Z), ghost (gsh1, L) g)).
Definition Gprog : funspecs := ltac:(with_library prog [surely_malloc_spec; load_acq_spec; store_rel_spec;
read_spec; write_spec; make_node_spec; writer_spec; reader_spec]).

(* Specifications: *)
Lemma body_surely_malloc: semax_body Vprog Gprog f_surely_malloc surely_malloc_spec.
Lemma land_1 : forall i, Z.land i 1 = i mod 2.
Definition list_max v l := fold_right Z.max v l.
Lemma list_max_app : forall v l1 l2, list_max v (l1 ++ l2) = list_max (list_max v l2) l1.
Lemma list_max_max : forall l v1 v2, Z.max v1 (list_max v2 l) = list_max (Z.max v1 v2) l.
Lemma list_max_spec : forall l v, v <= list_max v l /\ Forall (fun v' => v' <= list_max v l) l.
Lemma node_state_snap : forall sh L v version locs g,
view_shift (node_state sh L v version locs g)
(node_state sh L v version locs g * node_state Share.bot L v version locs g).
Lemma body_read : semax_body Vprog Gprog f_read read_spec.
(* Since the public view of the data structure has no data content (it's just the ghost state), there's no need for the backing-out linearization point reasoning (and in fact the linearization point can be anywhere, since all new write really guarantees is that no other data will be written at that version, plus maybe a certain eventual consistency). *)
Lemma body_write : semax_body Vprog Gprog f_write write_spec.
Lemma body_make_node : semax_body Vprog Gprog f_make_node make_node_spec.
Lemma body_writer : semax_body Vprog Gprog f_writer writer_spec.