Section GHist.
(* Ghost histories in the style of Nanevsky *)
Context {hist_el : Type}.
Notation hist_part := (nat -> option hist_el).
Definition hist_sub sh (h : hist_part) hr := sh <> Share.bot /\ if eq_dec sh Tsh then h = hr
else map_incl h hr.
Definition ghost_hist (sh : share) (h : hist_part) g :=
own(RA := ref_PCM map_disj_PCM) g (Some (sh, h), None) NoneP.
Definition hist_incl (h : hist_part) l := forall t e, h t = Some e -> nth_error l t = Some e.
Definition hist_list (h : hist_part) l := forall t e, h t = Some e <-> nth_error l t = Some e.
Definition ghost_ref l g := EX hr : hist_part, !!(hist_list hr l) &&
own(RA := ref_PCM map_disj_PCM) g (None, Some hr) NoneP.
Definition ghost_hist_ref sh (h r : hist_part) g :=
own(RA := ref_PCM map_disj_PCM) g (Some (sh, h), Some r) NoneP.
Definition newer (l : hist_part) t := forall t', l t' <> None -> (t' < t)%nat.
(* We want to be able to remove irrelevant operations from a history, leading to a slightly weaker correspondence between history and list of operations. *)
Inductive hist_list' : hist_part -> list hist_el -> Prop :=
| hist_list'_nil : hist_list' empty_map []
| hist_list'_snoc : forall h l t e (Hlast : newer h t) (Hrest : hist_list' h l),
hist_list' (map_upd h t e) (l ++ [e]).
Hint Resolve hist_list'_nil.
Inductive add_events h : list hist_el -> hist_part -> Prop :=
| add_events_nil : add_events h [] h
| add_events_snoc : forall le h' t e (Hh' : add_events h le h') (Ht : newer h' t),
add_events h (le ++ [e]) (map_upd h' t e).
Hint Resolve add_events_nil.
End GHist.
Hint Resolve hist_incl_nil hist_list_nil hist_list'_nil add_events_nil.
(*Hint Resolve ghost_var_precise ghost_var_precise'.*)
Hint Resolve (*ghost_var_init*) master_init (*ghost_map_init*) ghost_hist_init : init.
Ltac ghost_alloc G :=
match goal with |-semax _ (PROPx ?P (LOCALx ?Q (SEPx ?R))) _ _ =>
apply (semax_pre_bupd (PROPx P (LOCALx Q (SEPx ((EX g : _, G g) :: R)))));
[go_lower; rewrite !prop_true_andp by (repeat (split; auto));
rewrite <- emp_sepcon at 1; eapply derives_trans, bupd_frame_r;
apply sepcon_derives, derives_refl; apply own_alloc; auto; simpl; auto with init|] end.
Ltac ghosts_alloc G n :=
match goal with |-semax _ (PROPx ?P (LOCALx ?Q (SEPx ?R))) _ _ =>
apply (semax_pre_bupd (PROPx P (LOCALx Q (SEPx ((EX lg : _, !!(Zlength lg = n) && iter_sepcon G lg) :: R)))));
[go_lower; rewrite !prop_true_andp by (repeat (split; auto));
rewrite <- emp_sepcon at 1; eapply derives_trans, bupd_frame_r;
apply sepcon_derives, derives_refl; apply own_list_alloc'; auto; simpl; auto with init|] end.

Lemma wand_nonexpansive: forall P Q n,
approx n (P -* Q)%logic = approx n (approx n P  -* approx n Q)%logic.