Fixpoint sinv (n: nat) : { T:Type & Setoid T } :=
    match n with
      | O => existT (fun T => Setoid T) unit (EqSetoid unit)
      | S n => existT (fun T => Setoid T)
                  (prodT (projT1 (sinv n))
                         (Mor (ProdSetoid  (Fs (projT2 (sinv n))) otherS) (Ts)))
                  (ProdSetoid (projT2 (sinv n)) (MorSetoid _ _))
    end.Fixpoint floor (m:nat) (n:nat) (p:projT1 (sinv (m+n))) : projT1 (sinv n) :=
    match m as m' return forall (p : projT1 (sinv (m'+n))), projT1 (sinv n) with
    | O => fun p => p
    | S m' => fun p => floor m' n (fst p)
    end p.

(* Specifications: *)
Lemma floor_mor : forall m n, Morphism ( (@equiv _ (projT2 (sinv (m+n)))) ==> (@equiv _ (projT2 (sinv n)))) (floor m n).