Set Implicit Arguments.
Inductive fold_rel (A: Type) (f: A -> A -> A -> Prop):  A -> list A -> A -> Prop :=
| fold_rel_nil: forall w, fold_rel f w nil w
| fold_rel_cons: forall a l w w1 w2,
f w a w1 ->
fold_rel f w1 l w2 ->
fold_rel f w (a::l) w2.
Inductive list_forall2 {A B} (P: A -> B -> Prop): list A -> list B -> Prop :=
| list_forall2_nil:
list_forall2 P nil nil
| list_forall2_cons:
forall a1 al b1 bl,
P a1 b1 ->
list_forall2 P al bl ->
list_forall2 P (a1 :: al) (b1 :: bl).
Fixpoint replace (A: Type) (l: list A) (n:nat) (new: A) {struct n} : option (list A) :=
match (l, n) with
| (nil, n) => None
| (x :: xs, O) => Some (new :: xs)
| (x :: xs, S n) =>
match (replace xs n new) with
|  None => None
|  Some xs => Some (x :: xs)
end
end.
Definition list_join {A} {JA: Join A}: A -> list A -> A -> Prop :=
fold_rel join.
Definition age1_list {A} `{ageable A} := list_forall2 age.
(*****************************)
Hint Resolve @join_comparable @join_comparable'  @join_comparable'' @join_comparable'''
@join_comparable2 @join_comparable2'  @list_join_comparable @list_join_comparable'
@joins_comparable  @joins_comparable2  @join_sub_comparable  @join_sub_comparable2
@eq_comparable  @eq_comparable2
: comparable.
Hint Immediate @comparable_refl  @comparable_sym  : comparable.
Ltac Comp1 phi1 phi2 :=
solve [ eauto 3 with comparable typeclass_instances |
match goal with
| H: comparable phi1 ?phi |- _ => Comp2 H phi1 phi phi2
| H: comparable ?phi phi1 |- _ => Comp2 H phi1 phi phi2
| H: join phi1 ?phia ?phib |- _ =>  Comp3 H phi1 phia phib phi2
| H: join ?phia phi1 ?phib |- _ =>   Comp3 H phi1 phia phib phi2
| H: join ?phia ?phib phi1 |- _ =>   Comp3 H phi1 phia phib phi2
| H: joins phi1 ?phi |- _ =>  Comp2 H phi1 phi phi2
| H: joins ?phi phi1 |- _ =>  Comp2 H phi1 phi phi2
| H: join_sub phi1 ?phi |- _ => Comp2 H phi1 phi phi2
| H: join_sub ?phi phi1 |- _ => Comp2 H phi1 phi phi2
| H: list_join phi1 _ ?phi |- _ =>  Comp2 H phi1 phi phi2
| H: list_join ?phi _ phi1 |- _ =>  Comp2 H phi1 phi phi2
| H: phi1 = ?phi  |- _ => Comp2 H phi1 phi phi2
| H: ?phi = phi1  |- _ => Comp2 H phi1 phi phi2
end]
with Comp2 H phi1 phi phi2 :=
solve [apply comparable_trans with phi;
[eauto 3 with comparable  typeclass_instances |clear H; Comp1 phi phi2]
| clear H; Comp1 phi1 phi2]
with Comp3 H phi1 phia phib phi2 :=
solve [apply comparable_trans with phia;
[eauto 3 with comparable typeclass_instances |clear H; Comp1 phia phi2]
|apply comparable_trans with phib;
[eauto 3 with comparable  typeclass_instances | clear H; Comp1 phib phi2]
| clear H; Comp1 phi1 phi2].
Ltac Comp := match goal with
| |- comparable ?phi1 ?phi2 => Comp1 phi1 phi2
| |-  level ?phi1 = level ?phi2 => apply comparable_fashionR; Comp1 phi1 phi2
(*                | |- level _ = level _ => rewrite comparable_level; Comp *)
end.
Definition not_any_younger {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A} (phi phi': A)  : Prop :=
exists phi1, necR phi phi1 /\ comparable phi1 phi'.

Lemma nec_join3 {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}: forall {x x' y' z' : A},
join x' y' z' ->
necR x x' ->
exists y,
exists z,
join x y z /\ necR y y' /\ necR z z'.