srfi minus 35 at srfi dot schemers dot org
にメールを送信してください。
このメーリングリストに参加する方法については
ここの説明
を参照せよ。
この SRFI に関する議論については
メーリングリストのアーカイブ
を参照せよ。
この SRFI に関する確定後の議論については
メーリングリストのアーカイブ
を参照せよ。
この SRFI ではコンディション型やその値を作成して利用するための手続きとマクロについて述べる。 コンディション値は例外的な状況に関する情報をカプセル化する。 この SRFI では少数の基本的なコンディション型も定義する。
コンディションは、プログラムのコード間で例外的な状況に関する情報を受け渡しするための値である。 例外を検出するコードは、例外を処理するコードとは別の場所に存在する可能性があるし、 全く独立したコードであることも有り得るだろう。 したがって、例外を効果的に処理するためには、 コンディションはできるだけ多くの正確な情報を保持できなければならなず、 かつ、実際の例外状況を知らなくても効果的な処理ができなければならない。
この SRFI では、効果的な情報の伝達を行うための２つの仕組みを提供する。
コンディションは名前付きフィールドを持つレコードである。 コンディションは 1 つまたは複数のコンディション型 (condition type) に属する。 コンディション型はフィールド名のセットを定義する。 あるコンディション型に属するコンディションは、 そのコンディション型が定義するフィールド名に対応する値を保持する。 それらの値は、フィールド名を指定することで、そのコンディションから取得することができる。
コンディション型は &condition 型をルートとするツリーを形成する。
このルートとなる型以外のすべてコンディション型は、親となるコンディション型が存在する。
あるコンディションが複数のコデンィション型に属しており、 それらの型に共通の基底型 (supertype) が存在する場合、 その基底型のフィールドに対応する値は、 各コンディション型ごとに異なった値であってもよい。 その場合、フィールドにアクセスときに使用する型によって、 どの値が返されるかが決まる。 プログラムは、それぞれのフィールド値を取得することができる。
(make-condition-type id
parent
field-names)
make-condition-type は新しいコンディション型を返す。
引数 id はシンボルであり、コンディション型のシンボリックな名前として使用される。
引数 parent には親となるコンディション型を指定する。
引数 field-names はシンボルのリストであり、
新しいコンディション型のフィールド名を指定する。
field-names は parent およびその祖先のフィールド名と重複してはならない。
(condition-type? thing)
condition-type?
はコンディション型であるかを判定する述語である。
thing がコンディション型であれば #t を返し、
そうでなければ #f を返す。
(make-condition type
field-name
value
...)
make-condition
はコンディション型 type に属するコンディション値を作成して返す。
それに続く引数は、フィールド名と任意の値である。
コンディション型 type およびその祖先のすべてのフィールドに対して、
フィールド名と値を指定しなければならない。
make-condition は、指定されたフィールド値を持つコンディション値を返す。
(condition? thing)
condition? はコンディションであるかを判定する述語である。
thing がコンディションであれば #t を返し、
そうでなければ #f を返す。
(condition-has-type? condition
condition-type)
condition-has-type? は、
コンディション condition
がコンディション型 condition-type
に属するかを判定する。
condition が属するコンディション型のいずれかが、
condition-type またはその子孫であれば
#t を返し、そうでなければ #f を返す。
condition がコンディションでない場合、 あるいは、condition-type がコンディション型でない場合は、エラーである。
(condition-ref condition
field-name)
引数 condition はコンディションであり、
引数 field-name はシンボルである。
condition が属するコンディション型またはその祖先は、
フィールド名 field-name を持たなければならない。
condition-ref はフィールド名 field-name
に関連付けられた値を返す。
コンディションが持っていないフィールドを参照するとエラーになる。
(make-compound-condition condition0
condition1
...)
make-compound-condition
は合成コンディション (compound condition) を返す。
返されるコンディションは、各コンディション
conditioni が属するすべてのコンディション型に属する。
condition-ref を合成コンディションに適用すると、
指定されたフィールドを持つ最初の conditioni
のフィールド値を返す。
(extract-condition condition
condition-type)
コンディション condition はコンディション型
condition-type に属していなければならない。
extract-condition
は condition と同じフィールド値を持つ、
コンディション型 condition-type のコンディションを返す。
condition が合成コンディションの場合、
extract-condition は、
その合成コンディションを作成するときに make-compound-condition
手続きに指定したサブコンディションのうち、
コンディション型 condition-type に属する最初のコンディションのフィールド値を返す。
返されるコンディションは、新しく作成される可能性がある。たとえば、次の式が偽になることが有り得る。
(let* ((&c (make-condition-type 'c &condition '()))
(c0 (make-condition &c))
(c1 (make-compound-condition c0)))
(eq? c0 (extract-condition c1 &c)))
(define-condition-type <condition-type> <supertype> <predicate> <field-spec> ...)
このマクロは新しいコンディション型を定義する。
<condition-type>, <supertypes>, <predicate>
はすべて識別子でなければならない。
define-condition-type
は識別子 <condition-type> をコンディション型を示す何らかの値として定義する。
<supertype> は既存のコンディション型の名前でなければならない。
define-condition-type
は <predicate> を、
新しく定義したコンディション型、または、
その派生型に属するコンディションであることを判定する述語として定義する。
各 <field-spec> は (<field> <accessor>)
という形式でなければならない。
ここで <field> と <accessor> は共に識別子である。
define-condition-type
は各 <accessor> を、
新しく定義されたコンディション型に属するコンディションから
フィールド値を取得するための手続きとして定義する。
(condition <type-field-binding> ...)
このマクロはコンディション値を作成する。
各 <type-field-binding> は (
<condition-type> <field-binding> ...)
の形式、
各 <field-binding> は (
<field> <exp>)
の形式でなければならない。
ここで <field> はコンディション型 <condition-type>
のフィールド識別子である。
<exp> は順不同で評価される。 作成されたコンディションに、そのコンディション型またはその基底型のアクセッサを適用すると、 この値を取得することができる。
condition マクロにより返されるコンディションは、
次の式により作成することができる。
(make-compound-condition (make-condition <condition-type> '<field-name> <value>...) ...)
ここで、コンディション型の順序は condition マクロにおける順序と同じでなければならない。
各 <type-field-binding> は、
コンディション型 <condition-type> が定義するすべてのフィールドに対して
重複なくフィールド値を指定しなければならない。
しかしこの制限には例外があり、
フィールド値を指定しなかった場合でも、
そのフィールドがそのコンディション型の基底型のフィールドであり、
その基底型をもつ別のコンディション型の
<type-field-binding> においてフィールド値が指定されているなら、
condition マクロにおけるそのような最初のフィールド値が
暗黙に使用される。
&condition
これはコンディション型階層のルートとなる型である。フィールドは持たない。
&message
このコンディション型は次のようにして定義することができる。
(define-condition-type &message &condition
message-condition?
(message condition-message))
コンディションの性質を人間に伝達するためのメッセージを保持する。
&serious
このコンディション型は次のようにして定義することができる。
(define-condition-type &serious &condition
serious-condition?)
このコンディション型は、無視できないほどの重大な状況であることを表す。 このコンディション型は、他のコンディション型の基底型となることを意図している。
&error
このコンディション型は次のようにして定義することができる。
(define-condition-type &error &serious
error?)
このコンディション型はエラーを表す。 典型的な用途としては、プログラムが外部の世界やユーザーと相互作用したときに発生した、 何らかの良くない出来事を表す。
(define-condition-type &c &condition
c?
(x c-x))
(define-condition-type &c1 &c
c1?
(a c1-a))
(define-condition-type &c2 &c
c2?
(b c2-b))
(define v1 (make-condition &c1 'x "V1" 'a "a1"))
(c? v1) => #t
(c1? v1) => #t
(c2? v1) => #f
(c-x v1) => "V1"
(c1-a v1) => "a1"
(define v2 (condition (&c2
(x "V2")
(b "b2"))))
(c? v2) => #t
(c1? v2) => #f
(c2? v2) => #t
(c-x v2) => "V2"
(c2-b v2) => "b2"
(define v3 (condition (&c1
(x "V3/1")
(a "a3"))
(&c2
(b "b3"))))
(c? v3) => #t
(c1? v3) => #t
(c2? v3) => #t
(c-x v3) => "V3/1"
(c1-a v3) => "a3"
(c2-b v3) => "b3"
(define v4 (make-compound-condition v1 v2))
(c? v4) => #t
(c1? v4) => #t
(c2? v4) => #t
(c-x v4) => "V1"
(c1-a v4) => "a1"
(c2-b v4) => "b2"
(define v5 (make-compound-condition v2 v3))
(c? v5) => #t
(c1? v5) => #t
(c2? v5) => #t
(c-x v5) => "V2"
(c1-a v5) => "a3"
(c2-b v5) => "b2"
以下の参照実装では、 SRFI 1 「リスト ライブラリ」, SRFI 9 「レコード型の定義」, SRFI 23 「エラー報告機構」 を利用している。
(define-record-type :condition-type
(really-make-condition-type name supertype fields all-fields)
condition-type?
(name condition-type-name)
(supertype condition-type-supertype)
(fields condition-type-fields)
(all-fields condition-type-all-fields))
(define (make-condition-type name supertype fields)
(if (not (symbol? name))
(error "make-condition-type: name is not a symbol"
name))
(if (not (condition-type? supertype))
(error "make-condition-type: supertype is not a condition type"
supertype))
(if (not
(null? (lset-intersection eq?
(condition-type-all-fields supertype)
fields)))
(error "duplicate field name" ))
(really-make-condition-type name
supertype
fields
(append (condition-type-all-fields supertype)
fields)))
(define-syntax define-condition-type
(syntax-rules ()
((define-condition-type ?name ?supertype ?predicate
(?field1 ?accessor1) ...)
(begin
(define ?name
(make-condition-type '?name
?supertype
'(?field1 ...)))
(define (?predicate thing)
(and (condition? thing)
(condition-has-type? thing ?name)))
(define (?accessor1 condition)
(condition-ref (extract-condition condition ?name)
'?field1))
...))))
(define (condition-subtype? subtype supertype)
(let recur ((subtype subtype))
(cond ((not subtype) #f)
((eq? subtype supertype) #t)
(else
(recur (condition-type-supertype subtype))))))
(define (condition-type-field-supertype condition-type field)
(let loop ((condition-type condition-type))
(cond ((not condition-type) #f)
((memq field (condition-type-fields condition-type))
condition-type)
(else
(loop (condition-type-supertype condition-type))))))
; The type-field-alist is of the form
; ((<type> (<field-name> . <value>) ...) ...)
(define-record-type :condition
(really-make-condition type-field-alist)
condition?
(type-field-alist condition-type-field-alist))
(define (make-condition type . field-plist)
(let ((alist (let label ((plist field-plist))
(if (null? plist)
'()
(cons (cons (car plist)
(cadr plist))
(label (cddr plist)))))))
(if (not (lset= eq?
(condition-type-all-fields type)
(map car alist)))
(error "condition fields don't match condition type"))
(really-make-condition (list (cons type alist)))))
(define (condition-has-type? condition type)
(any (lambda (has-type)
(condition-subtype? has-type type))
(condition-types condition)))
(define (condition-ref condition field)
(type-field-alist-ref (condition-type-field-alist condition)
field))
(define (type-field-alist-ref type-field-alist field)
(let loop ((type-field-alist type-field-alist))
(cond ((null? type-field-alist)
(error "type-field-alist-ref: field not found"
type-field-alist field))
((assq field (cdr (car type-field-alist)))
=> cdr)
(else
(loop (cdr type-field-alist))))))
(define (make-compound-condition condition-1 . conditions)
(really-make-condition
(apply append (map condition-type-field-alist
(cons condition-1 conditions)))))
(define (extract-condition condition type)
(let ((entry (find (lambda (entry)
(condition-subtype? (car entry) type))
(condition-type-field-alist condition))))
(if (not entry)
(error "extract-condition: invalid condition type"
condition type))
(really-make-condition
(list (cons type
(map (lambda (field)
(assq field (cdr entry)))
(condition-type-all-fields type)))))))
(define-syntax condition
(syntax-rules ()
((condition (?type1 (?field1 ?value1) ...) ...)
(type-field-alist->condition
(list
(cons ?type1
(list (cons '?field1 ?value1) ...))
...)))))
(define (type-field-alist->condition type-field-alist)
(really-make-condition
(map (lambda (entry)
(cons (car entry)
(map (lambda (field)
(or (assq field (cdr entry))
(cons field
(type-field-alist-ref type-field-alist field))))
(condition-type-all-fields (car entry)))))
type-field-alist)))
(define (condition-types condition)
(map car (condition-type-field-alist condition)))
(define (check-condition-type-field-alist the-type-field-alist)
(let loop ((type-field-alist the-type-field-alist))
(if (not (null? type-field-alist))
(let* ((entry (car type-field-alist))
(type (car entry))
(field-alist (cdr entry))
(fields (map car field-alist))
(all-fields (condition-type-all-fields type)))
(for-each (lambda (missing-field)
(let ((supertype
(condition-type-field-supertype type missing-field)))
(if (not
(any (lambda (entry)
(let ((type (car entry)))
(condition-subtype? type supertype)))
the-type-field-alist))
(error "missing field in condition construction"
type
missing-field))))
(lset-difference eq? all-fields fields))
(loop (cdr type-field-alist))))))
(define &condition (really-make-condition-type '&condition
#f
'()
'()))
(define-condition-type &message &condition
message-condition?
(message condition-message))
(define-condition-type &serious &condition
serious-condition?)
(define-condition-type &error &serious
error?)
Copyright (C) Richard Kelsey, Michael Sperber (2002). All Rights Reserved.
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.