warnの出力抑制はどうやって実現しているのか

warnの出力を抑制する方法

(handler-bind ((warning #'muffle-warning))
  (warn "Hello"))

やった！

warn関数とその周辺の実装を考える

Common Lispのwarningの話題です。
warn関数では警告を出力できますが、 その出力を抑止したい場合はどうしたらいいでしょうか。

先行して回答を示したように、handler-bindとmuffle-warningを組み合わせて 設定することでwarnの出力を抑止することができます。

つまり、単純に

(warn "Hello")

と実行すると、

WARNING: Hello

みたいな出力が出るのですが、

(handler-bind ((warning #'muffle-warning))
  (warn "Hello"))

では何も出力されません。
これは一体どのような仕組みで実行されているのでしょうか？

handler-bindとmuffle-warningという組み合わせから、 conditionとrestartが手を組んでいることがわかると思います。 たかがwarning抑止だと舐めてかかれるようなモノじゃなく、 なんか知らんが結構複雑ですので、ちゃんと説明していきます。

muffle-warningとは何か

muffle-warningはrestart関数と呼ばれています。
最後に使い方を説明しますが、warningを中断させる機能があります。
restart関数は他にもあり、abort関数やらcontinue関数がそれにあたります。 restart関数の内容は、多少の差異はあるものの大体決まっており、 find-restartとinvoke-restartの2つにより構成されています。

muffle-warningの実装例である、muffle-warning!を下記に示します。

(defun muffle-warning! (&optional condition)
  (let ((restart (find-restart 'muffle-warning! condition)))
    (if restart
      (invoke-restart restart)
      (error (make-condition 'control-error)))))

たぶんどの処理系でもこんな感じに実装されていると思います。 find-restartで探して、見つかったならそれをinvokeするというもの。

つまりは、warningというconditionを受け取ったら、 muffle-warningより、再起動関数が呼び出されることになります。 逆にいうなら、warning conditionをsignalで呼び出す前には、 必ずrestart-bindかrestart-caseにてmuffle-warning restartを用意してあげなければ control-errorになってしまいます。 この要件が、まずはwarn関数を作成する際に必要になります。

注意点としては、restart関数は自分の関数名と同じ名前のrestartを探します。 今の場合、muffle-warning関数は、muffle-warningという名前のrestartを 探してinvokeしているのです。 関数名とrestartの名前はわざと同じにしているのですが、 同じsymbolでも無関係であることを覚えておいた方がいいと思います。

自作のwarning conditionを作る

テスト用にwarning conditionを作りましょう。
要件は1つ。formatの2要素である、format文字列と引数を受け取れることです。 slotを作るのが面倒なのでsimple-conditionを継承します。 名前はwarning!とします。

(define-condition warning! (simple-condition) ())

(defmethod print-object ((instance warning!) stream)
  (let ((format (simple-condition-format-control instance))
        (args (simple-condition-format-arguments instance)))
    (apply #'format stream format args)))

print-object methodは、例えばprincなんかで引数として与えられたときに、 どういう文字列を出力するかを指定するものです。 深く考えずに、warning!が受け取った引数から、formatをそのまま出力してやります。

例えばこんな感じ。

(let ((inst (make-condition
              'warning! :format-control "HELLO" :format-arguments nil)))
  (format t "~S~%" inst))
→ HELLO

自作のwarn関数を作る

では、上記の要件から、自作のwarn関数である、warn!関数を作成することを考えます。

要件は2つ。

• muffle-warning! restartを用意する。
• warning! conditionを実行する。

warn!関数の実装は下記のようになります。

(defun warn! (format &rest args)
  (restart-case
    (signal
      (make-condition
        'warning! :format-control format :format-arguments args))
    (muffle-warning! ())))

それではwarn!関数を次のように実行した場合はどうなるでしょうか。

(handler-bind ((warning! #'muffle-warning!))
  (warn! "Hello"))

warn!関数は、まずはmuffle-warning! restartを用意したあと、 warn! instanceに出力内容を設定して、signalでconditionを呼び出します。
するとhandler-bindにより、muffle-warning!関数が呼び出されます。
muffle-warning!関数はinvokeによりwarn!関数に戻り、restart-caseが実行されます。
restart-caseの本体には何も記載がないものの、 bindではなくcaseであるため、warn!関数に制御がそのまま残り、 そして何もしないでwarn!関数が終了します。

流れは次のような感じになります。

• warn!起動
• signalによりhandler-bindのwarning!起動
• muffle-warning!関数実行
• restart-caseのmuffle-warning!起動
• restart-case終了
• warn!終了

これは本来のwarn関数の挙動と同じになります。

それではhandler-bind無しでwarn!を呼び出した場合はどうなるでしょうか。
残念ながらこのままでは、warning! conditionのhandlerが存在しないため、 signal関数が何もしないで終わってしまいます。 warn!関数が警告文字を出力するためには、 出力用のhandler-bindが必要となります。

出力用handler-bindを用意する

これはプログラマーが明示的に用意するものではなく、 Common Lisp処理系があらかじめ用意しておくものです。 warning!を出力するための、システムのコードを示します。

(handler-bind
  ((warning!
     (lambda (c)
       (format *error-output* "WARNING-TEST: ~A~%" c))))
  ;; code
  )

上記の;; codeの部分で、eval-loopであったり、 load関数だったりが動作するわけです。

この要件から、warn!関数は

(warn! "Hello")

としていたものは

(handler-bind
  ((warning!
     (lambda (c)
       (format *error-output* "WARNING-TEST: ~A~%" c))))
  (warn! "Hello"))

みたいな感じになります。 warn!関数がsignalを起動するため、handler-bindに制御が渡って、 format関数によりWARNING-TESTが出力されます。

一方、出力抑止である

(handler-bind ((warning! #'muffle-warning!))
  (warn! "Hello"))

は、

(handler-bind
  ((warning!
     (lambda (c)
       (format *error-output* "WARNING-TEST: ~A~%" c))))
  (handler-bind ((warning! #'muffle-warning!))
    (warn! "Hello")))

となります。

warn!関数はsignalによりhandler-bindを起動しますが、 内側のhandler-bindに制御が渡り、mufffle-warning!関数が呼び出されるため、 一番外側のhandler-bindには制御が渡らず、WARNING-TESTが出力されないのです。

この仕組みは、warning! conditionを途中で盗み見することができることを意味しています。 例えば次のコードを考えます。

(handler-bind
  ((warning!
     (lambda (c)
       (format *error-output* "<<<~A>>>~%" c))))
  (warn! "Hello"))

出力結果

<<<Hello>>>
WARNING-TEST: Hello

用意したhandler-bindで一度conditionを受け取ってから、 formatで<<<Hello>>>を出力させています。 conditionはそのまま外側に伝搬するので、 WARNING-TEST: Helloも出力されるわけです。

それでは、これ以上伝搬させたくない場合はどうしたらいいでしょうか？
そんな時に使用するのがmuffle-warning関数です。

(handler-bind
  ((warning!
     (lambda (c)
       (format *error-output* "<<<~A>>>~%" c)
       (muffle-warning! c))))
  (warn! "Hello"))

出力結果

<<<Hello>>>

テストコード

説明で作成した自作のwarn!関数を下記に示します。

(defun muffle-warning! (&optional condition)
  (let ((restart (find-restart 'muffle-warning! condition)))
    (if restart
      (invoke-restart restart)
      (error (make-condition 'control-error)))))

(define-condition warning! (simple-condition) ())

(defmethod print-object ((instance warning!) stream)
  (let ((format (simple-condition-format-control instance))
        (args (simple-condition-format-arguments instance)))
    (apply #'format stream format args)))

(defun warn! (format &rest args)
  (restart-case
    (signal
      (make-condition
        'warning! :format-control format :format-arguments args))
    (muffle-warning! ())))

(defmacro progn-warning (&body body)
  `(handler-bind
     ((warning! (lambda (c)
                  (format *error-output* "~&WARNING-TEST: ~A~%" c))))
     ,@body))


;;
;;  main
;;
(progn-warning
  (warn! "AAA")
  (warn! "BBB: ~A, ~A, ~A" 100 200 300)
  (handler-bind ((warning! #'muffle-warning!))
    (warn! "CCC")
    (warn! "DDD"))
  (warn! "EEE"))

出力例

WARNING-TEST: AAA
WARNING-TEST: BBB: 100, 200, 300
WARNING-TEST: EEE

clispだと2回出力されるのですが何故だろう。
無視します。