accomplish nothing

これは末尾再帰で木を走査で色々調べたときの副産物だけど、Gauche ユーザリファレンスの3.6.2 パフォーマンスに関するヒント曰く、

深い再帰: Gauche の仮想機械(VM)は効率的なローカルフレーム割り当てのためにスタックを使っています。再帰が深くなって(プログラムにもよりますが、大体数百回から千回) スタックがオーバーフローするとスタックの内容をヒープに退避するというオーバーヘッドが生じます。 あるデータ量を越えたところでパフォーマンスの低下が見られたならば、深い再帰がないか調べてみて下さい。

とのこと。マジですかと思って、件のエントリで使った非末尾再帰のcopy-treeに10^6の要素を持つリストを渡してみたら、スタックがあふれることなく普通に動いた。これは便利。

何年か前、Scheme:末尾再帰で木をトラバースを読んだときは何をしてるかさっぱりだったんだけど、今なら分かるんじゃないかなー、と思って暇な時間に考えてたら自分でも書けたので、結果に至る過程を記録。

ちょっとアレンジして、木のコピーを例に考える。まずは、普通の再帰で素直に書いてみる。

;; 素朴な木のコピー
(define (copy-tree tree)
  (let loop ((node tree))
    (if (pair? node)
        (cons (loop (car node)) (loop (cdr node)))
        node)))

単純で分かりやすい。これをベースに、継続渡しスタイルを利用して末尾再帰のコードに変換してみる。人力CPS変換。

ちなみに、継続渡しスタイルについての詳しい話や、継続渡しスタイルと末尾再帰（末尾呼び出し）の関係についての説明は、ここではしない。他人に色々説明できるほど深く理解をしているわけじゃないので。詳しく知りたい人は、先人の書いた良い文章があると思うから、そちらを読んで欲しい。例えばThe 90 minute Scheme to C compilerとか。

とりあえず、最初に最終的なコードから。

;; 継続渡しスタイルによる末尾再帰な木のコピー
(define (copy-tree tree)
  (let loop ((node tree)
             (cont values))
    (if (pair? node)
        (loop (car node)
              (lambda (x)
                (loop (cdr node)
                      (lambda (y)
                        (cont (cons x y))))))
        (cont node))))

再帰に馴染みがないと、見た瞬間に心理的に3メートルくらい引くと思う。今あらためて見たら、書いた自分でも1メートルくらい引いた。だけど、段階を踏めばそんなに意味不明でもないので、あまり心配しなくても良い。

最初の素直な再帰の例に戻って、

;; 素朴な木のコピー
(define (copy-tree tree)
  (let loop ((node tree))
    (if (pair? node)
        (cons (loop (car node)) (loop (cdr node)))
        node)))

まず、継続を渡していくための引数が必要になる。ここでは、contという引数を増やす。なお、継続に定番のkとかいう名前を代わりに付けると、そっち方面への馴染みが薄い人への攻撃力をさらに強化できる。継続の中身はまだ考えない。

;; 継続渡しのために引数を増やす
(define (copy-tree tree)
  (let loop ((node tree)
             (cont ))
    (if (pair? node)
        (cons (loop (car node)) (loop (cdr node)))
        node)))

次に、最初にcontに指定する継続を考える。つまり、コピーし終わった木を受け取る、一番最後に実行される継続。copy-treeはコピーした木を返す手続きにしたいので、受け取った値をそのまま返す継続が良い。(lambda (x) x)とかでも良いけど、出来合いで、より省タイプなvaluesを使う。最近はCommon Lispに染まっていたのでidentityを探したが、なかった。

;; 最初に指定する継続はvalues
(define (copy-tree tree)
  (let loop ((node tree)
             (cont values))
    (if (pair? node)
        (cons (loop (car node)) (loop (cdr node)))
        node)))

継続渡しスタイルでは、値を返す代わりに、値を渡して継続を呼ぶので、値を返す部分はすべて継続の呼び出しになる。この例では二ヶ所。

;; 値を返す部分で継続を呼ぶ
(define (copy-tree tree)
  (let loop ((node tree)
             (cont values))
    (if (pair? node)
        (cont (cons (loop (car node)) (loop (cdr node))))
        (cont node))))

そして本題。loopの再帰呼び出しのときに指定する継続について考える。まずは(loop (car node))から。

(loop (car node))の継続、つまり、(loop (car node))が返す値をどうしたいのかという話だけど、ご覧の通り、(loop (cdr node))が返す値とペアを作りたい。そして、それを継続contに渡したい。コードで表現するとこうなる。

;; (loop (car node))の継続
(lambda (x)
  (cont (cons x (loop (cdr node)))))

継続が分かったので、実際のコードに当てはめてみる。

;; (loop (car node))を継続渡しスタイルに変更
(define (copy-tree tree)
  (let loop ((node tree)
             (cont values))
    (if (pair? node)
        (loop (car node)
              (lambda (x)
                (cont (cons x (loop (cdr node))))))
        (cont node))))

同じように、次は(loop (cdr node))の継続についても考えてみる。xとペアを作り、contに渡したいので、

;; (loop (cdr node))の継続
(lambda (y)
  (cont (cons x y)))

となる。これを実際のコードに当てはめると、

;; (loop (cdr node))を継続渡しスタイルに変更
(define (copy-tree tree)
  (let loop ((node tree)
             (cont values))
    (if (pair? node)
        (loop (car node)
              (lambda (x)
                (loop (cdr node)
                      (lambda (y)
                        (cont (cons x y))))))
        (cont node))))

最初に紹介したコードと同じになった。ご覧の通り、二ヶ所ある再帰は両方とも末尾呼び出しになっている。

実際に試してみると、

gosh> (let* ((t1 '(0 1 2))
             (t2 (copy-tree t1)))
        (values (eq? t1 t2) (equal? t1 t2) t2))
#f
#t
(0 1 2)
gosh> (let* ((t1 '(0 (1 2)))
             (t2 (copy-tree t1)))
        (values (eq? t1 t2) (equal? t1 t2) t2))
#f
#t
(0 (1 2))
gosh> (let* ((t1 '(0 ((1) 2) 3))
             (t2 (copy-tree t1)))
        (values (eq? t1 t2) (equal? t1 t2) t2))
#f
#t
(0 ((1) 2) 3)
gosh> 

意図した通りの動作をしてる模様。めでたし。

以下おまけ。Common Lispに（中略）ので、constantlyを探したがなかったため、(lambda _ 1)。

;; 共通のwalkerを定義
(define (tree-walk tree leaf-proc inner-proc)
  (let loop ((node tree)
             (cont values))
    (if (pair? node)
        (loop (car node)
              (lambda (x)
                (loop (cdr node)
                      (lambda (y)
                        (cont (inner-proc x y))))))
        (cont (leaf-proc node)))))

;; 木のコピー
(define (copy-tree tree)
  (tree-walk tree values cons))

;; 葉を数える
(define (count-leaf tree)
  (tree-walk tree (lambda _ 1) +))

;; 葉を文字列に変換した木を作る
(define (copy-tree/string-node tree)
  (tree-walk tree
             (lambda (x)
               (if (null? x) x (x->string x)))
             cons))

関数型便利。