再帰のスタイル

注: この記事は既に再帰でプログラムを書くことに抵抗がない人向けの記事です

僕はよく再帰を書きます。でかい関数の場合、特によく再帰を使います。
基本的に、横に80文字以上、縦に20行以上ある関数は書きたくないので、
枝分かれの先を再帰を使ってどんどん分離します。
最近書いてるコードの例で言うとこんなかんじ。(何のコードでしょう?)

(defun %insert-state-rec (aa duration rest acc)
  (match rest
    ((list* (and ts (timed-state state time)) rest2)
     (if (applicable state aa)
         (if rest2
             (%insert-state-inner
              aa duration ts (+ time duration) rest2 (cons ts acc))
             (%insert-state-finish aa duration ts (cons ts acc)))
         (%insert-state-rec aa duration rest2 (cons ts acc))))
    (nil (%debug-insert-failure aa rest acc))))

(defun %insert-state-inner (aa duration earliest end rest acc)
  (ematch rest
    ((list* (and ts2 (timed-state state time)) rest2)
     (cond
       ((<= time end)
        (if (applicable state aa)
            (if rest2
                (%insert-state-inner aa duration earliest end rest2 (cons ts2 acc))
                (%insert-state-mergedto aa earliest duration (cons ts2 acc)))
            (%insert-state-rec aa duration rest2 (cons ts2 acc))))
       ((< end time)
        (if-let ((merged (%check-after-end-time aa end rest acc)))
          (%insert-state-merge aa duration earliest merged acc)
          (%insert-state-rec aa duration rest acc)))))))

(optima使っています。
再帰関数はlabelsではなく分けて書いてます。
名前には%をつけて再帰関数だとわかるようにする。
本番ではinline宣言する。)

この手法は、

• デバッグをbreakではなくてtraceで行えたり、
• profile ができたり、
• 末尾再帰なので最適化出来たり

と個人的には使いやすいのですが、ネックは 引数の数がどんどん増えること です。
上の例では引数6つとか、頭おかしいです。見にくいし。
でも、レキシカルに束縛しているのでこうするしかありません。
引数が増えると、sbclではたとえ末尾再帰でもレジスタに乗らないので、
(cf. http://www.sbcl.org/sbcl-internals/Full-Calls.html#Full-Calls )
どれくらいかはわかりませんがパフォーマンス悪化があるかもしれません。
(レジスタに乗らずスタックに載るという事は、
まあヒープには入らないもののメモリのほうに確保されるという事ですよね？
間違ってたらすみません。)

Binding special variables

そこで考えた他の手法。ひとつめは、special variable に bind すること。

(defun parse-domain-def (name body)
  ;; special variable, used in 
  ;; the initialization of subclause objects.
  (let ((*domain* (pddl-domain :name name)))
    (macrolet ((body-domain (accessor)
		 `(setf (,accessor *domain*)
			(,(concatenate-symbols 'parse accessor) body))))
      (body-domain requirements)
      (body-domain types)
      (body-domain predicates)
      (body-domain constants)
      (body-domain functions)
      (body-domain actions)
      (body-domain durative-actions)
      (body-domain derived-predicates))
    *domain*))

(これで私の研究分野がわかった人もいるはず。。。)

こうすれば、コールスタックの上の方の関数は、
引数として domain を渡されることなく、
現在パース中のドメイン domain を見ることができるわけです。

ただし、そのぶん密結合になります。
(これ、後でスレッド並列化するときにスゴイ心配だったんですが、
special変数でも letでバインドすれば スレッドごとに独立にバインドされるんですね。よかった。)

Emulate bindings with restart system

ほかの手法は、restartを活用すること。
つまり、コールスタックの上からコールスタックの下の値を取得するために、
毎回restart-bindの中からerrorを投げて、コールスタックの下まで戻る。
呼び出し元のハンドラがこれを受けて、restart-handlerを目的の値を引数に呼び出す。

これは、呼び出し元をまだ作っていない時や、何から呼び出されるかわからないときに有効。

(defun callee-fun ()
  (restart-case
      (error 'need-value)
    (use-value (val)
      val)))

;; case 1, direct call
(defun caller-fun1 ()
  (handler-bind ((need-value
                  (lambda ()
                    (use-value 1))))
    (callee-fun)))

;; nested calls ...
(defun caller-fun2 (n)
  (print n)
  (print (callee-fun)))

(defun caller-fun3 (list)
  (do-this list)
  (do-that list)
  (mapcar #'caller-fun2 list))
  
;; ...

(defun caller-fun100 ()
  (handler-bind ((need-value
                  (lambda ()
                    (use-value 2))))
    (caller-fun99)))

コールスタックの途中に一つでもhandlerがいればいいわけです。
だから、再帰を使っている時でも簡単に対応できます。
handlerを元に作っているので、たとえば default handler や、
restart-bind の :test-function を活用することもできます。

ネックは速度でしょうか。restartの実装ってあまり話題になりません。
たぶんrestart systemを使っている人が少ないからです。もっと使えばいいのに。
あとは、handlerを貼れる数に制限があるかもしれません。

ここで色々と思うのは、多分ML系言語の人は、
長い引数リストの代わりに型というか構造体を作ってしまうからあまり問題にならないのではないか、とか。(ホント?)
しかし今の所clは遅延評価について(マクロで実現はできるが)そんなに効率良くはなれないしなあ、とか。

おまけ、Restart utility

そんなこんなで頻繁にrestartを使う私は、こんなマクロを使ってます。
一つ目はrestart-return、これはrestart-caseの構文がrestart-bindと違うのが非常に気に入らず、書いたもの。

(defmacro restart-return (bindings &body body)
  (with-gensyms (block-name)
    (let ((bindings2
           (mapcar
            (lambda (binding)
              (destructuring-bind
                    (name function . key-value-pair)
                  binding
                (with-gensyms (fn-name rest)
                  (list `(,fn-name
                          (&rest ,rest)
                          (return-from ,block-name
                            (apply #',function ,rest)))
                        `(,name (lambda (&rest ,rest)
                                  (apply #',fn-name ,rest))
                                ,@key-value-pair)))))
            bindings)))
      `(block ,block-name
         (flet ,(mapcar #'first bindings2)
           (restart-bind
               ,(mapcar #'second bindings2)
             ,@body))))))

あとはdo-restart、これはretry系の書き方を何度もするのが嫌で入れた。

(defmacro do-restart (bindings &body body)
  (with-gensyms (start)
    `(tagbody
        ,start
        (block nil
          (restart-bind
              ,(mapcar
                (lambda (binding)
                  (destructuring-bind
                        (name function . key-value-pair)
                      binding
                    (with-gensyms (rest)
                      `(,name (lambda (&rest ,rest)
                                (prog1
                                    (apply ,function ,rest)
                                  (go ,start)))
                              ,@key-value-pair))))
                bindings)
            ,@body)))))

使い道としては

(do-restart ((retry (lambda (c) (print :retry)))
         (continue (lambda (c) (print :retry))))
  (error "error!"))

書き捨て御免！