Section Domain.
Variable Dom : Set.
Inductive tree : Set :=
| leaf : Dom -> tree
| cons : tree -> tree -> tree.
End Domain.
(* Binary trees labeled by natural numbers *)
Definition nat_tree := tree nat.
Definition nat_cons := cons nat.
Definition nat_leaf := leaf nat.
(* Product of all the leaves of some nat_tree *)
Fixpoint leavemult (t : nat_tree) : nat :=
match t return nat with
| leaf n1 =>
(* (nat_leaf n1) *)  n1 (* (nat_cons t1 t2) *)
| cons t1 t2 => leavemult t1 * leavemult t2
end.
(* the specification  of our problem: *)
Definition SPECIF (t : nat_tree) := {n : nat | n = leavemult t}.
(* A (too much) trivial proof *)
intro t.
unfold SPECIF in |- *.
apply exist with (leavemult t); auto.
Defined.
(* Here we  define a predicate "Has an occurrence of O" *)
Fixpoint Has_Zero (t : nat_tree) : Prop :=
match t return Prop with
| leaf n1 =>
(* (nat_leaf n1) *) n1 = 0 (* (nat_cons t1 t2) *)
| cons t1 t2 => Has_Zero t1 \/ Has_Zero t2
end.
(* If some tree t has an occurence of 0, then (leavmult t)=0 *)
simple induction t.
simple induction d; simpl in |- *; auto. intros t1 H1 t2 H2 H.
simpl in |- *. elim H; intro H0.
cut (leavemult t1 = 0). intro H3. rewrite H3; simpl in |- *; auto. auto.
cut (leavemult t2 = 0). intro H3. rewrite H3; simpl in |- *.
symmetry  in |- *; apply mult_n_O. auto.
Qed.
(* A  proof of (t:nat_tree)(SPECIF t) which uses the preceding lemma *)
Let subtree_ersatz (t' t : nat_tree) := Has_Zero t' -> Has_Zero t.
Let kappa (t t' : nat_tree) := forall n' : nat, n' = leavemult t' -> SPECIF t.

Theorem cpsalgo : forall t : nat_tree, SPECIF t.