In-Place Reversal... of Trees

We've seen before that we can traverse a tree in constant stack space; that is, we've come up with a tail-recursive BFS traversal:

let fold_bfs f e t =
  let rec fold e = function
  | []       -> e
  | L x :: q -> fold (f e x) q
  | N t :: q -> fold e (List.rev_append (List.rev q) t)
  in fold e [t]

Unfortunately, this version is rather inefficient, as it copies the "queue" of nodes already waiting to be visited just to reverse it, and then copies it again to prepend it to the current node's children, finally discarding both the original and its reverse. This generates two garbage nodes per tree node processed. This outer copy is absolutely local to the traversal, since the first argument to rev_append is fresh. We can thus replace it by an in-place reversal of q.

Suppose we had a function rplacd that, given two lists l ≠ [] and m, physically modified the tail of l to be m, while returning l's old tail:

val rplacd : 'a list -> 'a list -> 'a list

With it we can write an in-place reversing function as:

let rec ip_revappend l v =
   if l == [] then v else
   let t = rplacd l v in
   ip_revappend t l

(I use a let-binding to make explicit the sequencing between the replacement and the recursive invocation). Compare this with the purely functional version:

let rec revappend l v = match l with
| []     -> v
| h :: t -> revappend t (h :: v)

In OCaml, we can use the module Obj to (carefully!) write replacd:

let rplacd : 'a list -> 'a list -> 'a list = fun l m ->
   let o = Obj.repr l in
   let t = Obj.field o 1 in
   Obj.set_field o 1 (Obj.repr m);
   Obj.obj t

(the type annotations are essential for OCaml to infer the correct types for Obj.obj). Putting it all together, and inlining rplacd in ip_revappend to avoid the call:

let rec ip_revappend (l : 'a list) v =
    if l == [] then v else
    let o = Obj.repr l in
    let t = Obj.obj (Obj.field o 1) in
    Obj.set_field o 1 (Obj.repr v);
    ip_revappend t l

(again, the type annotation is essential). In the absence of sharing, ip_revappend is observationally equivalent to revappend. Since, as explained above, the outer list is free, the following traversal is unconditionally observationally equivalent to the previous version:

let fold_bfs f e t =
  let rec fold e = function
  | []       -> e
  | L x :: q -> fold (f e x) q
  | N t :: q -> fold e (ip_revappend (List.rev q) t)
  in fold e [t]

Even so, it differs from it in that it produces just one garbage node per tree node traversed. This is optimal if we want to preserve the tree: concretely, q is the list of younger siblings, so as a part of the tree it should be preserved. If the tree is ephemeral, however, we can also replace the inner rev q by an ip_revappend q [] to recruit the nodes of the tree to serve as the tail of the traversal queue.

So, by stepwise, mechanical refinement, we arrive at an in-place ip_fold_bfs that uses constant stack and heap space:

let ip_fold_bfs f e t =
  let rec fold e = function
  | []       -> e
  | L x :: q -> fold (f e x) q
  | N t :: q -> fold e (ip_revappend (ip_revappend q []) t)
  in fold e [t]

This is the main point of Sobel and Friedman's paper.