End KNOT_HERED.
Module KnotHered (TF':TY_FUNCTOR_PROP) : KNOT_HERED with Module TF:=TF'.
Module TF:=TF'.
Definition sinv_prod X := prod X (F X * other -> Prop).
Definition guppy_sig := (fun T:Type => T * (F T * other -> Prop) -> 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_step_prop (Z:guppy_ty) (xf:sinv_prod (guppy_step_ty Z)) :=
forall (k:F (guppy_step_ty Z)) (o:other),
snd xf (k,o) -> snd (proj1_sig (fst xf)) (fmap F (@fst _ _ oo @proj1_sig _ _) 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 _ => True).
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) * other -> Prop) -> 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) }.
Definition k_age1 (k:knot) : option (knot) :=
match k with
| (existT _ 0 f) => None
| (existT _ (S m) f) => Some
(existT (F oo sinv) m (fmap F (@fst _ _ oo @proj1_sig _ _) f))
end.
Definition k_age (k1 k2:knot) := k_age1 k1 = Some k2.
Definition ko_age1 (x:knot * other) :=
match k_age1 (fst x) with
| None => None
| Some a' => Some (a',snd x)
end.
Definition ko_age x y := ko_age1 x = Some y.
Definition predicate := { p:knot * other -> Prop | hereditary ko_age p }.
Definition app_sinv (n:nat) (p:sinv (S n)) (x:F (sinv n) * other) :=
snd (proj1_sig p) x.

(* Specifications: *)
Lemma app_sinv_age : forall n (p:sinv (S (S n))) (f:F (sinv (S n)) * other),
app_sinv (S n) p f ->
app_sinv n (fst (proj1_sig p)) (fmap F (@fst _ _ oo @proj1_sig _ _) (fst f), snd f).