Section tree_ind.
Variable P : tree -> Prop.
Hypothesis P_atom : forall a, P (atom a).
Hypothesis P_node : forall l, List.Forall P l -> P (node l).
Definition tree_ind (t : tree) : P t :=
tree_rect P (List.Forall P)
(List.Forall_nil _)
(fun t l Pt Pl => List.Forall_cons _ Pt Pl) P_atom P_node t.
End tree_ind.
End tree.
Fixpoint rev_rec {A} (l : list A) (acc : list A) :=
match l with
| [] => acc
| a :: l => rev_rec l (a :: acc)
end.
Definition rev' {A} (l : list A) :=
rev_rec l [].
Fixpoint map_rec {A B} (f : A -> B) (l : list A) (acc : list B) :=
match l with
| [] => rev' acc
| a :: l => map_rec f l (f a :: acc)
end.
Definition list_map' {A B} (f : A -> B) (l : list A) :=
map_rec f l [].
intros.
unfold list_map'.
now rewrite map_rec_spec.
Qed.
(* The shape of a tree can be expressed by mapping (fun _ => tt) over it. *)
Fixpoint map {A B} (f : A -> B) (t : tree A) : tree B :=
match t with
| atom a => atom (f a)
| node l => node (List.map (map f) l)
end.
Definition shape {A} (t : tree A) : tree unit :=
map (fun _ => tt) t.
Fixpoint tree_map' {A B} (f : A -> B) (t : tree A) : tree B :=
let fix tree_map_loop {A B} (f : A -> B) (l : list (tree A)) acc :=
match l with
| [] => rev_rec acc []
| a :: l => tree_map_loop f l (map f a :: acc)
end in
match t with
| atom a => atom (f a)
| node l => node (tree_map_loop f l [])
end.
Definition tree_map_loop :=
fix tree_map_loop {A B} (f : A -> B) (l : list (tree A)) acc :=
match l with
| [] => rev_rec acc []
| a :: l => tree_map_loop f l (map f a :: acc)
end.
(* Fill out a tree using a list of elements given in preorder traversal order. *)
Fixpoint fill' {A B} (x : tree A) (bs : list B) : option (tree B * list B) :=
let fix fill'_list (l : list (tree A)) (bs : list B) : option (list (tree B) * list B) :=
match l with
| [] => Some ([], bs)
| x :: l => match fill' x bs with None => None
| Some (x, bs) =>
match fill'_list l bs with None => None
| Some (l, bs) =>
Some (x :: l, bs)
end
end
end in
match x with
| atom _ => match bs with
| [] => None
| b :: bs => Some (atom b, bs)
end
| node l => match fill'_list l bs with None => None
| Some (l, bs) => Some (node l, bs)
end
end.
(* Copy paste of local definition above. *)
Definition fill'_list {A B} :=
fix fill'_list (l : list (tree A)) (bs : list B) : option (list (tree B) * list B) :=
match l with
| [] => Some ([], bs)
| x :: l => match fill' x bs with None => None
| Some (x, bs) =>
match fill'_list l bs with None => None
| Some (l, bs) =>
Some (x :: l, bs)
end
end
end.
Definition fill {A B} (x : tree A) (bs : list B) : option (tree B) :=
match fill' x bs with None => None
| Some (t, _) => Some t
end.
(* Produce a preorder traversal list of elements *)
Fixpoint preorder {A} (x : tree A) : list A :=
let fix preorder_list (l : list (tree A)) : list A :=
match l with
| [] => []
| x :: l => preorder x ++ preorder_list l
end
in
match x with
| atom a => [a]
| node l => preorder_list l
end.
Definition preorder_list {A} :=
fix preorder_list (l : list (tree A)) : list A :=
match l with
| [] => []
| x :: l => preorder x ++ preorder_list l
end.
Fixpoint preorder' {A} (x : tree A) : list A :=
let fix preorder_list (l : list (tree A)) acc : list A :=
match l with
| [] => acc
| x :: l => preorder_list l (acc ++ preorder x)
end
in
match x with
| atom a => [a]
| node l => preorder_list l []
end.

(* Since the shape is expressed as mapping, we will need the fact that filling out the a mapped tree with the elements of the original tree gives the original. *)
Lemma fill'_preorder :
forall A B (f : B -> A) t (bs : list B),
fill' (map f t) (preorder t ++ bs) = Some (t, bs).