シグナルを使って木構造をインタラクティブに探索する

prologのバックトラックのように，木構造といった構造を探索して，条件にマッチしたらsignalを飛ばして，その値を採用するか・採用せずに次の値を探すか，という決定を上にやってもらう，ということをやりたい場合はどうしたらよいのだろう．

試しに，木構造を探索して，葉にぶつかったらコンディションをシグナリングして，それを採用するかしないかをデバッガに選んでほしいときのコードを考えてみた．

(ql:quickload :iterate)
(use-package :iterate)

(defstruct tr title children)

(define-condition found-leaf-condition ()
  ((leaf :reader leaf :initarg :leaf))
  (:report (lambda (c s) (format s "found leaf: ~A" (leaf c)))))

(define-condition leaf-accepted-condition () ((leaf :reader leaf :initarg :leaf)))

(defun first-leaf (tr)
  (handler-bind ((leaf-accepted-condition #'(lambda (c) (return-from first-leaf (leaf c)))) ;; 受諾された場合のコンディションハンドラ
                 (t #'(lambda (c) (invoke-debugger c)))) ;; 候補が見付かった場合のコンディションハンドラ
      (first-leaf% tr)))

(defun first-leaf% (tree)
  (if (null (tr-children tree))
    (restart-case (signal (make-condition 'found-leaf-condition :leaf tree))
      (next () nil)
      (accept () (signal (make-condition 'leaf-accepted-condition :leaf tree)))))
    (iterate:iter (for child-tree in (tr-children tree))
      (first-leaf% child-tree)))

(first-leaf
 (make-tr
  :title "root"
  :children
  (list (make-tr
         :title "a"
         :children
         (list (make-tr
                :title "b"
                :children nil)
               (make-tr
                :title "c"
                :children (list (make-tr
                                 :title "ca"
                                 :children nil)))
               (make-tr
                :title "d"
                :children nil))))))

ここでは2つのコンディションが使われている．条件に合致する値(葉)を発見したときにこれを伝えるためのfound-leaf-conditionと，デバッガが値を受諾したときに，その値を返り値として関数から脱出させるためのleaf-accepted-conditionだ．こういうふうに二段構えにシグナルを活用することで，条件に合致する値の発見と受諾をインタラクティブに行うことができた．

より一般化すると，木構造以外にも適用できて面白いかもしれない．