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) _.
Next Obligation.
hnf; simpl; intros.
destruct x; destruct y; destruct H; simpl in *.
subst n0.
constructor.
apply mor_prf; auto.
Qed.
Program Definition unsquash : Mor knotS natFS :=
Build_Mor _ _
(fun x =>
match x with existT n y => (n, fmap (unstratify n) y) end) _.
Next Obligation.
hnf; simpl; intros.
destruct x; destruct y; inversion H; clear H; subst; simpl.
split; auto.
apply mor_prf.
transitivity f3; auto.
replace f with f3.
reflexivity.
apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto.
Qed.
Definition level : Mor knotS (EqSetoid nat) := fstM oo unsquash.
Definition approx (n:nat) := unstratify n oo stratify n.

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.