Program Instance ag_knot : ageable knot :=
{ age1 := k_age1
; level := level
}.
Next Obligation.
econstructor.
(* unage *)
intros.
destruct (unsquash x') as [n f] eqn:?H; intros.
exists (squash (S n, f)).
rewrite knot_age_age1.
rewrite unsquash_squash.
f_equal.
apply unsquash_inj.
rewrite unsquash_squash.
rewrite H.
f_equal.
cut (f = fmap F (approx n) f).
intros.
rewrite fmap_app.
pattern f at 2. rewrite H0.
f_equal.
extensionality p.
apply predicate_eq.
extensionality w.
simpl. apply prop_ext.
intuition.
generalize H; intro.
rewrite <- (squash_unsquash x') in H.
rewrite H0 in H.
rewrite unsquash_squash in H.
congruence.
(* level 0 *)
intro x. destruct x; simpl.
destruct x; intuition; discriminate.
(* level S *)
intros. destruct x; simpl in *.
destruct x. discriminate.
inv H. simpl. auto.
Qed.
Existing Instance ag_prod.

(* Specifications: *)
Lemma approx_spec : forall n p (k:knot * other),
proj1_sig (approx n p) k = (ageable.level k < n /\ proj1_sig p k).
Lemma knot_level : forall k:knot, level k = fst (unsquash k).
End KnotHered.