Require Export VST.veric.base.
Local Open Scope pred.
Notation ghost_approx m := (ghost_fmap (approx (level m)) (approx (level m))).
(* Ownership construction based on "Iris from the ground up", Jung et al. *)
Program Definition ghost_is g: pred rmap :=
fun m => ghost_of m = ghost_approx m g.
Next Obligation.
intros ???? Hg.
rewrite (age1_ghost_of _ _ H), Hg.
pose proof (age_level _ _ H).
rewrite ghost_fmap_fmap, approx_oo_approx', approx'_oo_approx by omega; eauto.
Qed.
Definition Own g: pred rmap := allp noat && ghost_is g.
Fixpoint make_join (a c : ghost) : ghost :=
match a, c with
| nil, _ => c
| _, nil => nil
| None :: a', x :: c' => x :: make_join a' c'
| _ :: a', None :: c' => None :: make_join a' c'
| Some (ga, pa) :: a', Some (gc, _) :: c' => Some (gc, pa) :: make_join a' c'
end.
Program Definition bupd (P: pred rmap): pred rmap :=
fun m => forall c, joins (ghost_of m) (ghost_approx m c) ->
exists b, joins b (ghost_approx m c) /\
exists m', level m' = level m /\ resource_at m' = resource_at m /\ ghost_of m' = b /\ P m'.
Next Obligation.
Definition ghost_fp_update_ND a B :=
forall n c, joins (ghost_fmap (approx n) (approx n) a) c ->
exists b, B b /\ joins (ghost_fmap (approx n) (approx n) b) c.
Definition ghost_fp_update (a b : ghost) :=
forall n c, joins (ghost_fmap (approx n) (approx n) a) c ->
joins (ghost_fmap (approx n) (approx n) b) c.
Instance ghost_fp_update_preorder: RelationClasses.PreOrder ghost_fp_update.
Definition singleton {A} k (x : A) : list (option A) := repeat None k ++ Some x :: nil.
Definition gname := nat.
Definition own {RA: Ghost} (n: gname) (a: G) (pp: preds) :=
EX v : _, Own (singleton n (existT _ RA (exist _ a v), pp)).
Definition list_set {A} (m : list (option A)) k v : list (option A) :=
firstn k m ++ repeat None (k - length m) ++ Some v :: skipn (S k) m.
(* The addition of ghost state means that there are rmaps that have only cores for ghost state, but are not cores themselves (since they have ghost state at all). An rmap of this sort is not emp, but is its own unit. *)
Definition cored: pred rmap := ALL P : pred rmap, ALL Q : pred rmap,
P && Q --> P * Q.
Program Definition is_w w: pred rmap := fun w' => necR w w'.
Next Obligation.

Lemma join_singleton_inv: forall k a b RA c v pp,
join a b (singleton k (existT _ RA (exist _ (core c) v), pp)) ->
a = singleton k (existT _ RA (exist _ (core c) v), pp) \/ b = singleton k (existT _ RA (exist _ (core c) v), pp).