Program Instance prod_PCM (GA GB: Ghost): Ghost := { G := @G GA * @G GB;
valid a := valid (fst a) /\ valid (snd a); Join_G := Join_prod _ _ _ _ }.
Next Obligation.
intros GA GB ??? [] []; split; eapply join_valid; eauto.
Defined.
(* Can we use Santiago and Qinxiang's paper to simplify this? *)
Class PCM_order `{P : Ghost} (ord : G -> G -> Prop) := { ord_refl :> RelationClasses.Reflexive ord;
ord_trans :> RelationClasses.Transitive ord;
ord_lub : forall a b c, ord a c -> ord b c -> {c' | join a b c' /\ ord c' c};
join_ord : forall a b c, join a b c -> ord a c /\ ord b c; ord_join : forall a b, ord b a -> join a b a }.
(*Class lub_ord {A} (ord : A -> A -> Prop) := { lub_ord_refl :> RelationClasses.Reflexive ord; lub_ord_trans :> RelationClasses.Transitive ord; has_lub : forall a b c, ord a c -> ord b c -> exists c', ord a c' /\ ord b c' /\ forall d, ord a d -> ord b d -> ord c' d }.  Global Instance ord_PCM `{lub_ord} : Ghost := { Join_G a b c := ord a c /\ ord b c /\ forall c', ord a c' -> ord b c' -> ord c c' }.  Lemma join_compat : forall v1 v2 v' v'', join v2 v' v'' -> ord v1 v2 -> exists v0, join v1 v' v0 /\ ord v0 v''.  Lemma join_ord_eq : forall a b, ord a b <-> exists c, join a c b.  (* The master-snapshot PCM in the RCU paper divides the master into shares, which is useful for having both an authoritative writer and an up-to-date invariant. *)
Global Program Instance snap_PCM : Ghost :=
{ valid _ := True; Join_G a b c := sepalg.join (fst a) (fst b) (fst c) /\
if eq_dec (fst a) Share.bot then if eq_dec (fst b) Share.bot then join (snd a) (snd b) (snd c)
else ord (snd a) (snd b) /\ snd c = snd b else snd c = snd a /\
if eq_dec (fst b) Share.bot then ord (snd b) (snd a) else snd c = snd b }.
Next Obligation.
exists (fun '(sh, a) => (Share.bot, core a)); repeat intro.
+ destruct t; constructor; auto; simpl.
rewrite eq_dec_refl.
if_tac; [apply core_unit | split; auto].
rewrite join_ord_eq; eexists; apply core_unit.
+ destruct a, b, c; f_equal.
inv H; simpl in *.
destruct (eq_dec t Share.bot); [|destruct H1; subst; auto].
subst; apply bot_identity in H0; subst.
destruct (eq_dec t1 Share.bot); [|destruct H1; subst; auto].
* eapply join_core; eauto.
* rewrite join_ord_eq in H; destruct H.
eapply join_core; eauto.
Defined.
Next Obligation.
constructor.
- intros ???? [? Hjoin1] [? Hjoin2].
assert (fst z = fst z') by (eapply join_eq; eauto).
destruct z, z'; simpl in *; subst; f_equal.
destruct (eq_dec (fst x) Share.bot); [|destruct Hjoin1, Hjoin2; subst; auto].
destruct (eq_dec (fst y) Share.bot); [|destruct Hjoin1, Hjoin2; subst; auto].
eapply join_eq; eauto.
- intros ????? [Hsh1 Hjoin1] [Hsh2 Hjoin2].
destruct (sepalg.join_assoc Hsh1 Hsh2) as [sh' []].
destruct (eq_dec (fst b) Share.bot) eqn: Hb.
+ assert (fst d = fst a) as Hd.
{ eapply sepalg.join_eq; eauto.
rewrite e0; apply join_bot_eq. }
rewrite Hd in *.
assert (sh' = fst c) as Hc.
{ eapply sepalg.join_eq; eauto.
rewrite e0; apply bot_join_eq. }
rewrite Hc in *.
destruct (eq_dec (fst c) Share.bot) eqn: Hc1.
* destruct (eq_dec (fst a) Share.bot) eqn: Ha.
-- destruct (join_assoc Hjoin1 Hjoin2) as [c' []].
exists (Share.bot, c'); split; split; rewrite ?e2, ?e0, ?e1, ?eq_dec_refl in *; auto.
-- destruct Hjoin1 as [Hc' ?]; rewrite Hc' in *.
destruct Hjoin2, (ord_lub (snd b) (snd c) (snd a)) as [c' []]; eauto.
exists (Share.bot, c'); split; split; rewrite ?e0, ?e1, ?eq_dec_refl, ?Ha in *; auto.
* exists c.
destruct (eq_dec (fst a) Share.bot) eqn: Ha; try solve [split; split; auto].
-- destruct Hjoin2.
apply join_ord in Hjoin1; destruct Hjoin1.
split; split; rewrite ?e0, ?Ha, ?Hc1, ?eq_dec_refl; auto; split; auto; etransitivity; eauto.
-- destruct Hjoin2 as [He1 He2]; rewrite He1, He2 in *.
destruct Hjoin1 as [Hd' ?]; rewrite Hd' in *; split; split; rewrite ?e0, ?Ha, ?Hc1, ?eq_dec_refl, ?Hd'; auto.
+ exists (sh', snd b); simpl.
destruct (eq_dec (fst d) Share.bot).
{ rewrite e0 in Hsh1; apply join_Bot in Hsh1; destruct Hsh1; contradiction. }
destruct (eq_dec sh' Share.bot) eqn: Hn'.
{ subst; apply join_Bot in H; destruct H; contradiction. }
assert (snd d = snd b) as Hd by (destruct (eq_dec (fst a) Share.bot); tauto).
destruct Hjoin2 as [He ?]; rewrite He in *; split; split; simpl; rewrite ?Hb, ?Hn', ?Hd, ?He in *; auto.
- intros ??? []; split; [apply join_comm; auto|].
if_tac; if_tac; auto; tauto.
- intros ???? [? Hjoin1] [? Hjoin2].
assert (fst a = fst b) by (eapply join_positivity; eauto).
destruct (eq_dec (fst a) Share.bot), a, a', b, b'; simpl in *; subst; f_equal.
+ apply join_Bot in H0 as []; subst.
apply join_Bot in H as []; subst.
rewrite eq_dec_refl in Hjoin1, Hjoin2, Hjoin2.
eapply join_positivity; eauto.
+ destruct Hjoin1; auto.
Defined.
Next Obligation.
auto.
Defined.
Definition ghost_snap (a : @G P) p := own p (Share.bot, a) NoneP.

(* Specifications: *)
Lemma ghost_snap_join : forall v1 v2 p v, join v1 v2 v ->
ghost_snap v1 p * ghost_snap v2 p = ghost_snap v p.
Lemma ghost_snap_conflict : forall v1 v2 p, ghost_snap v1 p * ghost_snap v2 p |-- !!(joins v1 v2).
Lemma ghost_snap_join' : forall v1 v2 p,
ghost_snap v1 p * ghost_snap v2 p = EX v : _, !!(join v1 v2 v) && ghost_snap v p.