Section alt_rect2.
Variable P: T -> Type.
Variable Q: ne_list.L T -> Type.
Variable Pleaf: forall n, P (Leaf n).
Variable Pnode: forall l, Q l -> P (Node l).
Variable Qone: forall t, P t -> Q (ne_list.one t).
Variable Qcons: forall t l, P t -> Q l -> Q (ne_list.cons t l).
Fixpoint alt_rect2 (t: T): P t :=
match t return P t with
| Leaf x => Pleaf x
| Node l => Pnode ((fix F (l: ne_list.L T) :=
match l return Q l with
| ne_list.one t => Qone (alt_rect2 t)
| ne_list.cons x y => @Qcons x y (alt_rect2 x) (F y)
end) l)
end.
End alt_rect2.
Definition alt_ind2
(P: T -> Prop) (Q: ne_list.L T -> Prop)
(Pleaf: forall n, P (Leaf n))
(Pnode: forall l, Q l -> P (Node l))
(Qone: forall t, P t -> Q (ne_list.one t))
(Qcons: forall t l, P t -> Q l -> Q (ne_list.cons t l)): forall t, P t
:= alt_rect2 P Q Pleaf Pnode Qone Qcons.
Definition alt_rec2
(P: T -> Set) (Q: ne_list.L T -> Set)
(Pleaf: forall n, P (Leaf n))
(Pnode: forall l, Q l -> P (Node l))
(Qone: forall t, P t -> Q (ne_list.one t))
(Qcons: forall t l, P t -> Q l -> Q (ne_list.cons t l)): forall t, P t
:= alt_rect2 P Q Pleaf Pnode Qone Qcons.
Fixpoint head (t: T): E :=
match t with
| Leaf e => e
| Node l => head (ne_list.head l)
end.
Inductive In (e: E): T -> Prop :=
| InLeaf: In e (Leaf e)
| InNode l: InL e l -> In e (Node l)
with InL (e: E): ne_list.L T -> Prop :=
| InOne t: In e t -> InL e (ne_list.one t)
| InHead t l: In e t -> InL e (ne_list.cons t l)
| InTail t l: InL e l -> InL e (ne_list.cons t l).
Proof with auto.
induction l.
simpl.
intros.
inversion_clear H.
exists t.
split...
simpl.
intros.
inversion_clear H.
exists t.
split...
destruct (IHl H0).
destruct H.
exists x.
split...
Qed.
End contents.
Hint Constructors In.
Hint Resolve InLeaf.
Hint Resolve InNode.
Hint Resolve InOne.
Hint Resolve InHead.
Hint Resolve InTail.
(* todo: why don't the ctor hints remove the need for these? *)
Definition map (A B: Set) (f: A -> B): T A -> T B := fold (@Leaf _ ∘ f) (@Node _).
Add Parametric Morphism (A B: Set): (@map A B)
with signature (@ext_eq A B) ==> (@ext_eq (T A) (T B))
as map_ext_morph.
Proof with try reflexivity.
unfold ext_eq.
intros.
induction x0; simpl.
unfold compose.
rewrite H...
rewrite IHx0...
rewrite IHx0...
simpl in IHx1.
inversion_clear IHx1...
Qed.
Proof with auto.
induction t.
simpl.
rewrite comp_apply.
intros.
inversion_clear H.
eauto.
simpl.
intros.
inversion_clear H.
inversion_clear H0.
destruct (IHt H).
destruct H0.
subst.
eauto.
simpl.
intros.
inversion_clear H.
inversion_clear H0.
destruct (IHt H).
destruct H0.
subst.
eauto.
simpl in IHt0.
assert (In e (Node (ne_list.map (map f) l)))...
destruct (IHt0 H0).
destruct H1.
subst.
exists x.
split...
right.
inversion_clear H2...
Qed.

Lemma map_ext (A B: Set) (f g: A -> B): ext_eq f g -> forall x, map f x = map g x.