Module TF := TF'.
(* Put the discrete topped order on rhs *)
Inductive le_T : T -> T -> Prop :=
| le_T_refl : forall t1 t2,
t1 == t2 -> le_T t1 t2
| le_T_bot: forall t,
le_T T_bot t.
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.

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