(* 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) -->
weak_view_shift (R hx vx * P hc vc) (R (hx ++ [AE vx vc]) vc *
Q (map_upd hc (length hx) (AE vx vc)) vx) && emp.
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]).

(* Specifications: *)
(* proof of the lock-based implementation of atomic exchange *)
Lemma body_atomic_exchange : semax_body Vprog Gprog f_simulate_atomic_exchange atomic_exchange_spec.
Lemma AE_loc_join : forall sh1 sh2 sh l p g i R h1 h2 (Hjoin : sepalg.join sh1 sh2 sh)
(Hsh1 : readable_share sh1) (Hsh2 : readable_share sh2) (Hcompat : disjoint h1 h2),
AE_loc sh1 l p g i R h1 * AE_loc sh2 l p g i R h2 = AE_loc sh l p g i R (map_add h1 h2).