End KNOT_FULL.
Module KnotFull (TF':TY_FUNCTOR_FULL) : KNOT_FULL with Module TF:=TF'.
Module TF:=TF'.
Definition sinv_prod X := prod X (F X X * other -> T).
Definition guppy_sig := (fun X:Type => X * (F X X * other -> T) -> Prop).
Definition guppy_ty := sigT guppy_sig.
Definition guppy_step_ty (Z:guppy_ty) : Type :=
(sig (fun (x:sinv_prod (projT1 Z)) => projT2 Z x)).
Definition guppy_age (Z:guppy_ty) (x:guppy_step_ty Z) : projT1 Z := fst (proj1_sig x).
Definition guppy_unage (Z:guppy_ty)
(H:forall t, projT2 Z (t,fun _ => T_bot))
(x:projT1 Z) : guppy_step_ty Z :=
exist (fun z => projT2 Z z) (x, fun _ => T_bot) (H x).
(* Definition guppy_step_prop (Z:guppy_ty) (xf:sinv_prod (guppy_step_ty Z)) := forall (k:F (guppy_step_ty Z) (guppy_step_ty Z)) (k':F (projT1 Z) (projT1 Z)) (o o':other) H, ORel o o' -> Rel (projT1 Z) (projT1 Z) (bimap (guppy_unage Z H) (guppy_age Z) k) k' -> T_rel (snd xf (k,o)) (snd (proj1_sig (fst xf)) (k',o')). *)
Definition guppy_step_prop (Z:guppy_ty) (xf:sinv_prod (guppy_step_ty Z)) :=
(forall (k:F (guppy_step_ty Z) (guppy_step_ty Z)) (o:other) H,
T_rel (snd xf (k,o))
(snd (proj1_sig (fst xf)) (bimap (guppy_unage Z H) (guppy_age Z) k,o))) /\
(forall (k k':F (guppy_step_ty Z) (guppy_step_ty Z)) (o o':other),
Rel (guppy_step_ty Z) (guppy_step_ty Z) k k' ->
ORel o o' ->
T_rel (snd xf (k,o)) (snd xf (k',o'))).
Definition guppy_step (Z:guppy_ty) : guppy_ty :=
existT guppy_sig (guppy_step_ty Z) (guppy_step_prop Z).
Definition guppy_base : guppy_ty :=
existT guppy_sig unit
(fun xf =>
(forall (k k':F unit unit) (o o':other),
Rel unit unit k k' ->
ORel o o' ->
T_rel (snd xf (k,o)) (snd xf (k',o')))).
Fixpoint guppy (n:nat) : guppy_ty :=
match n with
| 0    => guppy_base
| S n' => guppy_step (guppy n')
end.
Definition sinv (n:nat) : Type := projT1 (guppy n).
Definition sinv_prop (n:nat) : prod (sinv n) (F (sinv n) (sinv n) * other -> T) -> Prop := projT2 (guppy n).
Fixpoint floor (m:nat) (n:nat) (p:sinv (m+n)) : sinv n :=
match m as m' return forall (p : sinv (m'+n)), sinv n with
| O => fun p => p
| S m' => fun p => floor m' n (fst (proj1_sig p))
end p.
Definition knot := { n:nat & F (sinv n) (sinv n) }.
Definition sinv_age n : sinv (S n) -> sinv n := guppy_age (guppy n).
Program Definition sinv_unage n : sinv n -> sinv (S n) := guppy_unage (guppy n) _.
Next Obligation.
revert t; induction n; simpl; auto.
repeat intro.
apply T_rel_bot.
split; simpl in *; repeat intro.
apply T_rel_bot.
apply T_rel_bot.
Qed.
Definition F_sinv n := F (sinv n) (sinv n).
Definition age1_def (k:knot) : option knot :=
match k with
| existT _ 0 f => None
| existT _ (S m) f => Some
(existT F_sinv m (bimap (sinv_unage m) (sinv_age m) f))
end.
Definition age_def x y := age1_def x = Some y.
Inductive knot_rel_inner : knot -> knot -> Prop :=
| intro_krel : forall n (f f':F_sinv n),
Rel _ _ f f' ->
knot_rel_inner (existT (F_sinv) n f) (existT (F_sinv) n f').
Definition hered (p:knot * other -> T) : Prop :=
forall k k' k'' o o',
clos_refl_trans _ age_def k k' ->
knot_rel_inner k' k'' -> ORel o o' ->
T_rel (p (k,o)) (p (k'',o')).
Definition predicate := { p:knot * other -> T | hered p }.
Definition app_sinv (n:nat) (p:sinv (S n)) (x:F_sinv n * other) :=
snd (proj1_sig p) x.
Section stratifies.
Variable Q:knot * other -> T.
Variable HQ:hered Q.
Fixpoint stratifies (n:nat) : sinv n -> Prop :=
match n as n' return sinv n' -> Prop with
| 0 => fun _ => True
| S n' => fun (p:sinv (S n')) =>
stratifies n' (fst (proj1_sig p)) /\
forall (k:F_sinv n') (o:other), snd (proj1_sig p) (k,o) = Q (existT F_sinv n' k,o)
end.

(* Specifications: *)
Lemma stratifies_unique : forall n p1 p2,
stratifies n p1 ->
stratifies n p2 ->
p1 = p2.