Set Bullet Behavior "Strict Subproofs".
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.
(*Definition release2_spec := DECLARE _release2 release2_spec. Definition freelock2_spec := DECLARE _freelock2 (freelock2_spec _). Definition spawn_spec := DECLARE _spawn spawn_spec.*)
Definition tnode := Tstruct _node noattr.
Opaque upto.
Definition make_loads lv := map (fun v => Load (vint v)) lv.
(* Invariant for version number: Every write increases it, and the version of each data location is at least the most recently read version. *)
(* Invariant for each location: The "rounded up" version number is at least the location's version. *)
Definition round_up i := i + i mod 2.
Definition round_down i := i - i mod 2.
(* Do we really need the hists? *)
(* Ghost vars act as write permissions. *)
Definition ver_R g gsh gv lg (h : list hist_el) v := ghost_master v g * ghost_var gsh v gv *
fold_right sepcon emp (map (ghost_snap (round_down v)) lg).
Definition loc_R g gsh gl gv (h : list hist_el) (v : Z) := EX ver : Z, EX ver' : Z,
!!(repable_signed ver' /\ ver <= round_up ver') &&
ghost_master ver g * ghost_var gsh ver gl * ghost_snap ver' gv.
Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(NDmk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15)
(fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15) => P%assert end)
(fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15) => Q%assert end))
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
x10 at level 0, x11 at level 0, x12 at level 0,  x13 at level 0, x14 at level 0,
x15 at level 0,
P at level 100, Q at level 100).
Definition read_spec :=
DECLARE _read
WITH n : val, out : val, sh : share, version : val, locs : list val, gv : val, gsh : share, gv' : val,
gv2 : val, lg : list val, lgl : list val, hv : hist, ghosts : list val, hists : list hist, v0 : Z
PRE [ _n OF tptr tnode, _out OF tptr tint ]
PROP (readable_share sh; Zlength lg = 8; Zlength ghosts = 8; Zlength hists = 8; v0 mod 2 = 0)
LOCAL (temp _n n; temp _out out)
SEP (data_at sh tnode (version, locs) n; data_at_ Tsh (tarray tint 8) out;
atomic_loc_hist sh version gv 0 (ver_R gv2 gsh gv' lg) hv; ghost_snap v0 gv2;
fold_right sepcon emp (map (fun i => atomic_loc_hist sh (Znth i locs Vundef) (Znth i ghosts Vundef) 0
(loc_R (Znth i lg Vundef) gsh (Znth i lgl Vundef) gv2) (Znth i hists [])) (upto 8));
fold_right sepcon emp (map (ghost_snap v0) lg))
POST [ tvoid ]
EX failvs : list Z, EX loops : Z, EX v : Z, EX hv' : hist, EX vals : list Z, EX hists' : list hist,
PROP (v mod 2 = 0; add_events hv (make_loads (failvs ++ [v; v])) hv'; Forall repable_signed failvs;
Forall repable_signed vals; Zlength hists' = 8; loops <= Zlength failvs)
LOCAL ()
SEP (data_at sh tnode (version, locs) n; data_at Tsh (tarray tint 8) (map (fun x => vint x) vals) out;
atomic_loc_hist sh version gv 0 (ver_R gv2 gsh gv' lg) hv'; ghost_snap v gv2;
fold_right sepcon emp (map (fun i => EX fails : list Z,
!!(add_events (Znth i hists []) (make_loads (fails ++ [Znth i vals 0])) (Znth i hists' []) /\
Zlength fails = loops) &&
atomic_loc_hist sh (Znth i locs Vundef) (Znth i ghosts Vundef) 0
(loc_R (Znth i lg Vundef) gsh (Znth i lgl Vundef) gv2) (Znth i hists' [])) (upto 8));
fold_right sepcon emp (map (ghost_snap v) lg)).
Notation "'WITH'  x1 : t1 , x2 : t2 , x3 : t3 , x4 : t4 , x5 : t5 , x6 : t6 , x7 : t7 , x8 : t8 , x9 : t9 , x10 : t10 , x11 : t11 , x12 : t12 , x13 : t13 , x14 : t14 , x15 : t15 , x16 : t16 , x17 : t17 'PRE'  [ u , .. , v ] P 'POST' [ tz ] Q" :=
(NDmk_funspec ((cons u%formals .. (cons v%formals nil) ..), tz) cc_default (t1*t2*t3*t4*t5*t6*t7*t8*t9*t10*t11*t12*t13*t14*t15*t16*t17)
(fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17) => P%assert end)
(fun x => match x with (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17) => Q%assert end))
(at level 200, x1 at level 0, x2 at level 0, x3 at level 0, x4 at level 0,
x5 at level 0, x6 at level 0, x7 at level 0, x8 at level 0, x9 at level 0,
x10 at level 0, x11 at level 0, x12 at level 0,  x13 at level 0, x14 at level 0,
x15 at level 0, x16 at level 0, x17 at level 0,
P at level 100, Q at level 100).
(* For now, we guarantee only one writer by using a ghost variable as a write permission. *)
Definition write_spec :=
DECLARE _write
WITH n : val, input : val, sh : share, version : val, locs : list val, vals : list Z, gv : val, gv2 : val,
gsh1 : share, gsh2 : share, gv' : val, lg : list val, lgl : list val, hv : hist, ghosts : list val,
hists : list hist, v : Z
PRE [ _n OF tptr tnode, _in OF tptr tint ]
PROP (readable_share sh; Forall repable_signed vals; Zlength lg = 8; Zlength lgl = 8; Zlength ghosts = 8;
Zlength hists = 8; v mod 2 = 0; readable_share gsh1; readable_share gsh2; sepalg.join gsh1 gsh2 Tsh)
LOCAL (temp _n n; temp _in input)
SEP (data_at sh tnode (version, locs) n; data_at Tsh (tarray tint 8) (map (fun x => vint x) vals) input;
atomic_loc_hist sh version gv 0 (ver_R gv2 gsh2 gv' lg) hv; ghost_snap v gv2; ghost_var gsh1 v gv';
fold_right sepcon emp (map (fun i => atomic_loc_hist sh (Znth i locs Vundef) (Znth i ghosts Vundef) 0
(loc_R (Znth i lg Vundef) gsh2 (Znth i lgl Vundef) gv2) (Znth i hists [])) (upto 8));
fold_right sepcon emp (map (ghost_snap v) lg); fold_right sepcon emp (map (ghost_var gsh1 v) lgl))
POST [ tvoid ]
EX hv' : hist, EX hists' : list hist,
PROP (add_events hv [Load (vint v); Store (vint (v + 1)); Store (vint (v + 2))] hv'; Zlength hists' = 8;
(v + 2) mod 2 = 0)
LOCAL ()
SEP (data_at sh tnode (version, locs) n; data_at Tsh (tarray tint 8) (map (fun x => vint x) vals) input;
atomic_loc_hist sh version gv 0 (ver_R gv2 gsh2 gv' lg) hv'; ghost_snap (v + 2) gv2;
ghost_var gsh1 (v + 2) gv';
fold_right sepcon emp (map (fun i =>
!!(add_events (Znth i hists []) [Store (vint (Znth i vals 0))] (Znth i hists' [])) &&
atomic_loc_hist sh (Znth i locs Vundef) (Znth i ghosts Vundef) 0
(loc_R (Znth i lg Vundef) gsh2 (Znth i lgl Vundef) gv2) (Znth i hists' [])) (upto 8));
fold_right sepcon emp (map (ghost_snap (v + 2)) lg);
fold_right sepcon emp (map (ghost_var gsh1 (v + 2)) lgl)).
Definition Gprog : funspecs := ltac:(with_library prog [load_SC_spec; store_SC_spec; read_spec; write_spec]).
Ltac cancel_for_forward_call ::= repeat (rewrite ?sepcon_andp_prop', ?sepcon_andp_prop);
repeat (apply andp_right; [auto; apply prop_right; auto|]); fast_cancel.

(* Specifications: *)
Lemma snap_snap_max : forall v1 v2 p,
ghost_snap v1 p * ghost_snap v2 p = ghost_snap v1 p * ghost_snap (Z.max v1 v2) p.
Lemma snaps_snaps_max : forall {cs : compspecs} (v1 v2 : Z) lg,
@view_shift cs
(fold_right sepcon emp (map (ghost_snap v1) lg) * fold_right sepcon emp (map (ghost_snap v2) lg))
(fold_right sepcon emp (map (ghost_snap v1) lg) * fold_right sepcon emp (map (ghost_snap (Z.max v1 v2)) lg)).
Lemma snaps_snaps_le : forall {cs : compspecs} v lg (lv : list Z) (Hlen : Zlength lv = Zlength lg),
@view_shift cs
(fold_right sepcon emp (map (ghost_snap v) lg) *
fold_right sepcon emp (map (fun '(v, g) => ghost_snap v g) (combine lv lg)))
(fold_right sepcon emp (map (ghost_snap v) lg) * EX lv : list Z, !!(Zlength lv = Zlength lg /\
Forall (fun v' => v <= v') lv) &&
fold_right sepcon emp (map (fun '(v, g) => ghost_snap v g) (combine lv lg))).
Lemma land_1 : forall i, Z.land i 1 = i mod 2.
Lemma round_down_mono : forall v1 v2, v1 <= v2 -> round_down v1 <= round_down v2.
Lemma round_up_max_distr : forall v1 v2, round_up (Z.max v1 v2) = Z.max (round_up v1) (round_up v2).
Lemma body_read : semax_body Vprog Gprog f_read read_spec.
Lemma ver_R_precise : forall g gsh gv lg v, precise (EX h : _, ver_R g gsh gv lg h v).
Hint Resolve ver_R_precise.
Lemma loc_R_precise : forall g gsh gl gv v, precise (EX h : _, loc_R g gsh gl gv h v).
Hint Resolve loc_R_precise.
Lemma body_write : semax_body Vprog Gprog f_write write_spec.
Inductive lin_op := Read (v : Z) (vals : list Z) | Write (v : Z) (vals : list Z).