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.

(* Specifications: *)
Lemma approx_spec : forall n p w, approx n p w == if (le_gt_dec n (level (fst w))) then T_bot else p w.
Lemma squash_unsquash : forall x, squash (unsquash x) == x.
Lemma unsquash_squash : forall n x', unsquash (squash (n,x')) == (n,fmap (approx n) x').