Program Definition squash : Mor natFS knotS :=
    Build_Mor _ _
     (fun x =>
       match x with (n,y) => existT (fun x => F (projT1 (sinv x))) n (fmap (stratify n) y) end) _.Program Definition unsquash : Mor knotS natFS :=
    Build_Mor _ _
      (fun x =>
        match x with existT n y => (n, fmap (unstratify n) y) end) _.Definition level : Mor knotS (EqSetoid nat) := fstM oo unsquash.Definition approx (n:nat) := unstratify n oo stratify n.

Lemma unsquash_squash : forall n x', unsquash (squash (n,x')) == (n,fmap (approx n) x').