Set Bullet Behavior "Strict Subproofs".
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.
Definition surely_malloc_spec :=
DECLARE _surely_malloc
WITH n:Z
PRE [ _n OF tuint ]
PROP (0 <= n <= Int.max_unsigned)
LOCAL (temp _n (Vint (Int.repr n)))
SEP ()
POST [ tptr tvoid ] EX p:_,
PROP ()
LOCAL (temp ret_temp p)
SEP (malloc_token Tsh n p * memory_block Tsh n p).
Definition tentry := Tstruct _entry noattr.
Definition entry_hists entries hists := fold_right_sepcon (map (fun i =>
let '(hp, e) := (Znth i hists ([], []), Znth i entries Vundef) in
ghost_hist (fst hp) (field_address tentry [StructField _key] e) *
ghost_hist (snd hp) (field_address tentry [StructField _value] e)) (upto 20)).
(* In this case, let map be an association list. *)
Fixpoint index_of (m : list (Z * Z)) (k : Z) :=
match m with
| [] => None
| (k1, v1) :: rest => if eq_dec k1 k then Some 0
else option_map Z.succ (index_of rest k)
end.
Definition set m k v :=
match index_of m k with
| Some i => upd_Znth i m (k, v)
| None => m ++ [(k, v)]
end.
Definition get m k := option_map (fun i => snd (Znth i m (0, 0))) (index_of m k).
Definition value_of e :=
match e with
| Load v => v
| Store v => v
| CAS r c w => if eq_dec r c then w else r
end.
Definition last_value (h : hist) v :=
(* initial condition *)
(h = [] /\ v = vint 0) \/
exists n e, In (n, e) h /\ value_of e = v /\ Forall (fun x => let '(m, _) := x in m <= n)%nat h.
Definition ordered_hist h := forall i j (Hi : 0 <= i < j) (Hj : j < Zlength h),
(fst (Znth i h (O, Store (vint 0))) < fst (Znth j h (O, Store (vint 0))))%nat.
Definition value_of_hist (h : hist) := value_of (snd (last h (O, Store (vint 0)))).
Definition wf_map (m : list (Z * Z)) := Forall (fun i => repable_signed i /\ i <> 0) (map fst m).
Definition int_op e :=
match e with
| Load v | Store v => tc_val tint v
| CAS r c w => tc_val tint r /\ tc_val tint c /\ tc_val tint w
end.
(* Once set, a key is never reset. *)
Definition k_R (h : list hist_el) (v : val) := !!(Forall int_op h /\
forall e, In e h -> value_of e <> vint 0 -> v = value_of e) && emp.
Definition v_R (h : list hist_el) (v : val) := emp.
Definition atomic_entry sh p := !!(field_compatible tentry [] p) && EX lkey : val, EX lval : val,
field_at sh tentry [StructField _lkey] lkey p *
atomic_loc sh lkey (field_address tentry [StructField _key] p) (vint 0) Tsh k_R *
field_at sh tentry [StructField _lvalue] lval p *
atomic_loc sh lval (field_address tentry [StructField _value] p) (vint 0) Tsh v_R.
(* Can we comprehend the per-entry histories into a broader history? *)
Definition failed_CAS k (a b : hist * hist) := exists t r, Forall (fun x => fst x < t)%nat (fst a) /\
fst b = fst a ++ [(t, CAS (Vint r) (vint 0) (vint k))] /\
r <> Int.zero /\ r <> Int.repr k /\ snd b = snd a /\
(let v := value_of_hist (fst a) in v <> vint 0 -> v = Vint r).
Definition wf_hists h l := Forall (fun x => ordered_hist (fst x) /\ ordered_hist (snd x) /\
Forall int_op (map snd (fst x)) /\ Forall int_op (map snd (snd x))) h /\ 0 <= l <= Zlength h /\
Forall (fun x => value_of_hist (fst x) <> vint 0) (sublist 0 l h) /\
Forall (fun x => value_of_hist (fst x) = vint 0) (sublist l (Zlength h) h).
Definition make_int v := match v with Vint i => Int.signed i | _ => 0 end.
Fixpoint make_map h :=
match h with
| [] => []
| (hk, hv) :: rest => let k := make_int (value_of_hist hk) in
if eq_dec k 0 then [] else (k, make_int (value_of_hist hv)) :: make_map rest
end.
Definition set_item_trace (h : list (hist * hist)) k v i h' := 0 <= i < Zlength h /\
Forall2 (failed_CAS k) (sublist 0 i h) (sublist 0 i h') /\
(let '(hk, hv) := Znth i h ([], []) in exists t r tv, Forall (fun x => fst x < t)%nat hk /\
Forall (fun x => fst x < tv)%nat hv /\
Znth i h' ([], []) = (hk ++ [(t, CAS r (vint 0) (vint k))], hv ++ [(tv, Store (vint v))]) /\
(r = vint 0 \/ r = vint k) /\ (let v := value_of_hist hk in v <> vint 0 -> v = r)) /\
sublist (i + 1) (Zlength h) h = sublist (i + 1) (Zlength h') h'.

Lemma set_item_trace_map : forall h k v i h' l (Hwf : wf_hists h l) (Htrace : set_item_trace h k v i h')
(Hk : k <> 0) (Hrepk : repable_signed k) (Hrepv : repable_signed v),
wf_hists h' (Z.max (i + 1) l) /\ let m' := make_map (sublist 0 i h' ++ sublist i (Zlength h) h) in
wf_map (set m' k v) /\ incl (make_map h) m' /\ make_map h' = set m' k v.