末尾再帰で木を走査
何年か前、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))関数型便利。