簡易な例外機構

Scheme プログラミングGauche

プログラミングGaucheのpp.292-293。他の主要な言語でいうところの例外みたいな仕組みすらcall/ccで実現可能らしい。
そういえば組込みのguardもcall/ccで実装されていると聞いたことがあるな。
call/ccどんだけー。


目標とするクライアントコードは次のとおり。

;;例外を投げるかもしれない手続き
(define div
  (lambda (n d)
    (if (= d 0)
        (throw DivideZeroError
               (print #`"ERROR: Divide Zero Error Occured...\n devide ,n by ZERO!\n-------------"))
        (/ n d))))

(define percentage
  (lambda (a b)
    (catch (DivideZeroError
            (print  (* (div a b) 100.0) "%"))
           (finally
            (print "follow ...")))))

catchの第1引数の第1引数と、throwの第1引数で与えているDivideZeroErrorってのは、発生したエラーの名前みたいなもん。C++やC#で例えると、例外の型名とでもいえるのかな。今日のこのエントリでは、便宜的に以降では例外名と呼ぶことにしよう。
throwは例外名とともに投げる値を指定する。
catch側でも例外名を指定して（第1引数の第1引数であるDivideZeroError）例外を捕捉する。tryが見つからないけど、catchの第1引数の第2引数以降がtryに相当する部分。finallyの引数は必ず実行される式。

ちなみに、100じゃなくて100.0で割らないと答えが分数で表示されてしまう。これで5分悩んだし＞＜

「#`」に文字列を続けると、その文字列内のカンマ直後の式を評価して文字列に埋め込んでくれるらしい。177ページを参照されたし。準クオートに似てるなあ。


ってことで、上記の内容を実現するマクロの定義は以下。

;;捕捉した継続のための大域変数
(define *signals* '())

;;try、catch、finallyに相当するところ
(define-syntax catch
  (syntax-rules (finally)
    ((_ (sig body ...) (finally follow ...))
     (let* ((signals-backup *signals*)
            (val (call/cc (lambda (k)
                            (set! *signals* (cons (cons 'sig k) *signals*))
                            body ...))))
       (set! *signals* signals-backup)
       follow ...
       val))
    ((_ sig body ...)
     (catch (sig body ...) (finally)))))

;;throwに相当するところ
(define-syntax throw
  (syntax-rules ()
    ((_ sig val)
     ((cdr (assq 'sig *signals*)) val))))

body ... を実行している間だけ例外名を登録しておけばいいので、signals-backupでもって前の状態を退避しているわけね。んで、body ... が終わったら、退避しておいたsignals-backupを復活させている。

call/cc内の「'sig」でちょっと意外だったけど、R5RSマクロだからかな？sigっていうシンボルじゃなくて、ちゃんとDivideZeroErrorっていうシンボルになるのね。

捕捉しておいた例外を取り出すところでassqなる手続きが使われているが、解説が見つからなかったので調べてみた。連想リストを検索する手続きassocに似ていて、equal?の代わりにeq?を使うバージョンらしい。
んで、取り出した例外にthrowの第2引数を渡して継続を実行すると、大域脱出みたいなことができるわけね。
今回の例とblockやfor-each-extで違うところは、継続をグローバル変数に捕まえておいて後で実行する点かな。

では、実行してみる。

gosh> (percentage 1 40)
2.5%
follow ...
#<undef>

gosh> (percentage 10 0)
ERROR: Divide Zero Error Occured...
 devide 10 by ZERO!
-------------
follow ...
#<undef>