Title

Conditions

Authors

Richard Kelsey and Michael Sperber

Status

This SRFI is currently in ``final'' status. To see an explanation of each status that a SRFI can hold, see here. It will remain in draft until 2002-10-20, or as amended. to provide input on this SRFI, please mail to srfi-35@srfi.schemers.org. See instructions here to subscribe to the list. You can access the discussion via the archive of the mailing list. You can access post-finalization messages via the archive of the mailing list.

概要

この SRFI ではコンディション型とそのインスタンスを作成し検査する 仕組みを定義する。コンディションの値により、例外的な状況についての情報や 例外そのものがカプセル化される。また、この SRFI では基本的なコンディションをいくつか定義する。

論理的根拠

コンディションは、プログラムのパーツ間で例外的な状況についての情報を やりとりする値である。例外を投げるコードとそれを扱う部分とは別の 部分であるかもしれない。実際、前者は後者とは別個に もう書いてあるかもしれない。したがって、例外のあつかいを簡単に効率よく おこなうためには、コンディションを使ってできるかぎり多くの情報を できるかぎり精確にやりとりし、起こりうる例外の性質をしっかりと予想して いないコードにでも効率よく例外があつかえるようにしておかなければ ならない。

この SRFI では、こういった目的を達成するためにふたつの仕組みを提供する。

仕様

コンディションは名前付きのフィールドをもった構造体である。 それぞれのコンディションはひとつ以上のコンディション型に属し、 コンディション型はフィールドの名前を規定する。 あるコンディション型に属するコンディションは、その型により規定される フィールド名に対応する値をもつ。これらの値は、適切なフィールド名を 指定することでコンディションから取り出すことができる。

コンディション型は &condition をルートとした階層構造をしてい、&condition 以外には親となるコンディション型が存在する。

コンディションが共通の上位型をもつコンディション型に複数属する場合、 それぞれの型が上位型のフィールドについて別の値を持つことがある。 このような場合にはフィールドにアクセスする型を指定すれば どの値を返すかを指定することができる。プログラムはこのようなフィールドの 値を別々に取り出すことができる。

手続き

(make-condition-type id parent field-names)

コンディション型を新しく作成し返す。 id はコンディション型の名前を表すシンボル、 parent はコンディション型の親となるコンディション型、 field-names はシンボルのリストで、 この型に対応するコンディションのフィールドを指定する。

field-nameparent や下位型のフィールド名と重複があってはならない。

(condition-type? thing)

thing がコンディション型であれば #t を返し、さもなくは #f を返す。

(make-condition type field-name value ...)

コンディション型 type に属するコンディションを作成する。 残りの引き数にはフィールドの名前とその値を順に指定する。 この名前・値のペアは type ないしその上位型のフィールド それぞれに対応してなければならない。 この手続きは作成したコンディション値のフィールドに 対応する引き数の値を格納して返す。

(condition? thing)

thing がコンディションであれば #t、さもなくは #f を返す。

(condition-has-type? condition condition-type)

コンディション condition がコンディション型 condition-type に属するかどうかテストする。condition の型のいずれかが、直接的に、もしくは上位型として、 condition-type を含んでいれば #t を返し、 さもなくは #f を返す。

condition がコンディションでない、 もしくは condition-type がコンディション型でない場合には エラーが通知される。

(condition-ref condition field-name)

condition はコンディション、 field-name はシンボルでなければならない。 さらに、conditionfield-name という名前のフィールドのあるコンディション型に属しているか、 所属するコンディション型の上位型に そのようなフィールドがなければならない。 この手続きは、field-name に対応する値を返す。

コンディションにないフィールドを参照するとエラーになる。

(make-compound-condition condition0 condition1 ...)

conditioni の属するすべてのコンディション型に属する合成コンディションを返す。

合成コンディションに condition-ref を適用すると、条件を満たすフィールドを持つ最初の conditioni に由来する値を返す。

(extract-condition condition condition-type)

conditioncondition-type に属するコンディションでなければならない。この手続きは、 condition で指定された値を持つ、 condition-type 型のコンディションを返す。

conditon が合成コンディションである場合、 コンディション作成時の 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> はすべて識別子でなければならない。 識別子 <condition-type> はコンディション型をあらわす値として定義される。<supertypes> は前以って定義されたコンディション型でなければならない。

また、そのコンディション型、ないしその下位型に対応する コンディションを同定する述語として <predicate> が定義される。

それぞれの <field-spec> は (<field> <accessor>)(<field> と <accessor> はどちらも識別子) という形式である。 それぞれの <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>...)
      ...)

各 <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 ("List Library")、 SRFI 9 ("Defining Record Types")、 SRFI 23 ("Error reporting mechanism") を使用している。

(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

Copyright (C) Richard Kelsey, Michael Sperber (2002). All Rights Reserved.

This document and translations of it may be copied and furnished to others, and derivative works that comment on or otherwise explain it or assist in its implementation may be prepared, copied, published and distributed, in whole or in part, without restriction of any kind, provided that the above copyright notice and this paragraph are included on all such copies and derivative works. However, this document itself may not be modified in any way, such as by removing the copyright notice or references to the Scheme Request For Implementation process or editors, except as needed for the purpose of developing SRFIs in which case the procedures for copyrights defined in the SRFI process must be followed, or as required to translate it into languages other than English.

The limited permissions granted above are perpetual and will not be revoked by the authors or their successors or assigns.

This document and the information contained herein is provided on an "AS IS" basis and THE AUTHOR AND THE SRFI EDITORS DISCLAIM ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION HEREIN WILL NOT INFRINGE ANY RIGHTS OR ANY IMPLIED WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.


Editor: Francisco Solsona