Module KI := KI'.Definition sinv_prod X := prod X (F X * other -> T).Definition guppy_sig := (fun X:Type => X * (F 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)) (o:other) H,
         T_rel (snd xf (k,o))
               (snd (proj1_sig (fst xf)) (fmap F (guppy_age Z) (guppy_unage Z H) k,o))) /\
    (forall (k k':F (guppy_step_ty Z)) (o o':other),
         Rel (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) (o o':other),
          Rel 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) * 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) }.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) _.Definition F_sinv n := F (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 (fmap F (sinv_age m) (sinv_unage 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').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.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.