(* 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.

(* Specifications: *)
Lemma fill'_preorder : forall A B (f : B -> A) t (bs : list B), fill' (map f t) (preorder t ++ bs) = Some (t, bs).
Lemma fill_preorder : forall A B (f : A -> B) t, fill (map f t) (preorder t) = Some t.