Section AEHist.
(* These histories should be usable for any atomically accessed location. *)
Inductive AE_hist_el := AE (r : val) (w : val).
Fixpoint apply_hist a h :=
match h with
| [] => Some a
| AE r w :: h' => if eq_dec r a then apply_hist w h' else None
end.
Arguments eq_dec _ _ _ _ : simpl never.
End AEHist.
Notation hist := (nat -> option AE_hist_el).
(* the lock invariant used to encode an atomic invariant *)
Definition AE_inv x g i R := EX h : list AE_hist_el, EX v : val,
!!(apply_hist i h = Some v /\ tc_val tint v) &&
(data_at Ews tint v x * ghost_ref h g * R h v).
Hint Resolve AE_inv_exclusive.
Definition AE_loc sh l p g i R (h : hist) := lock_inv sh l (AE_inv p g i R) * ghost_hist sh h g.
(* This predicate describes the valid pre- and postconditions for a given atomic invariant R. *)
Definition AE_spec i P R Q := ALL hc : _, ALL hx : _, ALL vc : _, ALL vx : _,
!!(apply_hist i hx = Some vx /\ hist_incl hc hx) -->
((R hx vx * P hc vc) -* (|==> R (hx ++ [AE vx vc]) vc *
Q (map_upd hc (length hx) (AE vx vc)) vx)).
Definition AE_type := ProdType (ProdType (ProdType
(ConstType (share * val * gname * val * val * val * hist))
(ArrowType (ConstType hist) (ArrowType (ConstType val) Mpred)))
(ArrowType (ConstType (list AE_hist_el)) (ArrowType (ConstType val) Mpred)))
(ArrowType (ConstType hist) (ArrowType (ConstType val) Mpred)).
(* specification of atomic exchange *)
Program Definition atomic_exchange_spec := DECLARE _simulate_atomic_exchange
TYPE AE_type WITH lsh : share, tgt : val, g : gname, l : val,
i : val, v : val, h : hist, P : hist -> val -> mpred, R : list AE_hist_el -> val -> mpred, Q : hist -> val -> mpred
PRE [ _tgt OF tptr tint, _l OF tptr (Tstruct _lock_t noattr), _v OF tint ]
PROP (tc_val tint v; readable_share lsh)
LOCAL (temp _tgt tgt; temp _l l; temp _v v)
SEP (AE_loc lsh l tgt g i R h; P h v; AE_spec i P R Q)
POST [ tint ]
EX t : nat, EX v' : val,
PROP (tc_val tint v'; newer h t)
LOCAL (temp ret_temp v')
SEP (AE_loc lsh l tgt g i R (map_upd h t (AE v' v)); Q (map_upd h t (AE v' v)) v').
Next Obligation.
Next Obligation.
Definition Gprog : funspecs := ltac:(with_library prog [acquire_spec; release_spec; atomic_exchange_spec]).

(* proof of the lock-based implementation of atomic exchange *)
Lemma body_atomic_exchange : semax_body Vprog Gprog f_simulate_atomic_exchange atomic_exchange_spec.