Let closedR (w1 w2:world) := fst w1 = fst w2.
Program Definition closedM : @modality world _ := exist _ closedR _.
Next Obligation.
split; repeat intro; unfold closedR in *;
destruct x as [? ?]; destruct y as [? ?];
destruct z as [? ?]; simpl in *; intuition subst.
hnf in H; simpl in H.
exists  (p,s1); simpl; auto.
hnf; simpl.
destruct (@age1 _ K.ageable_knot p0).
inv H. auto. discriminate.
hnf in H0; simpl in H0.
exists (p1,s); simpl; auto.
hnf; simpl in *.
destruct (@age1 _ K.ageable_knot p1).
inv H0. auto. discriminate.
Qed.
Definition closed := box closedM.
Inductive setR v x : relation world :=
intro_setR : forall p r r',
r' = r#v <- x ->
setR v x (p,r) (p,r').
Program Definition setM v x : @modality world _ := setR v x.
Next Obligation.
split; hnf; intros.
inv H0.
hnf in H; simpl in H.
case_eq (age1 p); intros; unfold prog in *;
rewrite H0 in H; try discriminate.
inv H.
exists (p0,r).
constructor; auto.
hnf. simpl. rewrite H0. auto.
inv H.
destruct z.
hnf in H0; simpl in H0.
case_eq (age1 p0); unfold prog in *; intros;
rewrite H in H0.
inv H0.
exists (p0,(r#v <- x)).
hnf. simpl. rewrite H. auto.
constructor; auto.
discriminate.
Qed.
Program Definition world_op (Pp : pred prog) (Pr : store -> Prop) : pred world :=
fun pr => let (p,r) := pr in Pp p /\ Pr r.
Next Obligation.
unfold hereditary; intros.
destruct a as [p r].
destruct a' as [p' r'].
hnf in H.
simpl in H.
rewrite K.knot_age1 in H.
case_eq (K.unsquash p); intros; rewrite H1 in H.
destruct n; try discriminate.
inv H.
intuition.
destruct Pp as [Pp HPp].
simpl.
simpl in H.
eapply HPp.
2: apply H.
hnf.
rewrite K.knot_age1.
rewrite H1; auto.
Qed.
Definition store_op (Pr : store -> Prop) := world_op TT Pr.
Definition prog_op (X:pred prog) :=  world_op X (fun _ => True).

(* Specifications: *)
Lemma worldNec_unfold : forall p r p' r',
@necR world _ (p,r) (p',r') <->
necR p p' /\ r = r'.
Lemma worldLater_unfold : forall p r p' r',
@laterR world _ (p,r) (p',r') <->
laterR p p' /\ r = r'.
Lemma worldNec_unfold : forall p r p' r',
@necR world _ (p,r) (p',r') <->
necR p p' /\ r = r'.
Lemma worldLater_unfold : forall p r p' r',
@laterR world _ (p,r) (p',r') <->
laterR p p' /\ r = r'.