(* * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor. * *)
Local Open Scope pred.
Definition fashionM {A} `{ageable A} : modality
:= exist _ fashionR valid_rel_fashion.
Existing Instance ag_nat. Hint Resolve ag_nat : core.
Program Definition fash {A: Type} `{NA: ageable A} (P: pred A): pred nat :=
fun n => forall y, n >= level y -> P y.
Next Obligation.
destruct P as [P HP].
simpl in *.
apply H0.
unfold age, age1, ag_nat,natAge1 in H.
destruct a; inv H.
omega.
Qed.
Notation "'#' e" := (fash e) (at level 30, right associativity): pred.
Definition fashionable  (P: pred nat) := # P = P.
Notation "P '>=>' Q" := (# (P --> Q)) (at level 55, right associativity) : pred.
Notation "P '<=>' Q" := (# (P <--> Q)) (at level 57, no associativity) : pred.
Program Definition unfash {A} `{agA: ageable A} (P: pred nat) : pred A :=
fun x => P (level x).
Next Obligation.
apply age_level in H.
rewrite H in H0.
eapply pred_hereditary; eauto. unfold age;  simpl. auto.
Qed.
Notation "'!' e" := (unfash e) (at level 30, right associativity): pred.

Lemma subp_derives {A} `{agA : ageable A} :
forall (P P' Q Q': pred A),
P' |-- P ->
Q |-- Q' ->
(P >=> Q) |-- (P' >=> Q').