(* * Copyright (c) 2009-2010, Andrew Appel, Robert Dockins and Aquinas Hobor. * *)
Local Open Scope pred.
(* Lemma box_contractive {A} `{ageable A} : forall F (M:modality), inclusion _ M fashionR -> contractive F -> contractive (fun X => box M (F X)).  Lemma box_nonexpansive {A} `{ageable A} : forall F (M:modality), inclusion _ M fashionR -> nonexpansive F -> nonexpansive (fun X => box M (F X)).  Lemma diamond_contractive {A} `{ageable A} : forall F (M:modality), inclusion _ M fashionR -> contractive F -> contractive (fun X => diamond M (F X)).  Lemma diamond_nonexpansive {A} `{ageable A} : forall F (M:modality), inclusion _ M fashionR -> nonexpansive F -> nonexpansive (fun X => diamond M (F X)). *)
Ltac sub_unfold :=
match goal with
| |- _ |-- ?A _ >=> ?A _ => unfold A
| |- _ |-- ?A _ _ >=> ?A _ _ => unfold A
| |- _ |-- ?A _ _ _ >=> ?A _ _ _ => unfold A
| |- _ |-- ?A _ _ _ _ >=> ?A _ _ _ _ => unfold A
| |- _ |-- ?A _ _ _ _ _ >=> ?A _ _ _ _ _ => unfold A
| v: _ |- _ => destruct v
end.
Hint Extern 2 (_ |-- _ >=> _) => sub_unfold : contractive.
Hint Resolve @prove_HOcontractive
@subp_allp @subp_imp @subp_refl @subp_exp @subp_andp @subp_orp @subp_subp
@allp_imp2_later_e1 @allp_imp2_later_e2 : contractive.

Lemma HORec_contractive {A} `{ageable A} : forall B
(F : pred A -> (B -> pred A) -> B -> pred A)
(HF1 : forall X, HOcontractive (F X))
(HF2 : forall R a, contractive (fun X => F X R a)),
forall a, contractive (fun X => HORec (F X) a).