type-descriptor 
	      'condition-type supertype #f #f #f 
	      (list->vector (transform-fields (field accessor) ...))))
	   (define constructor
	     (record-constructor 
	      (make-record-constructor-descriptor condition-type #f #f)))
	   (define predicate (condition-predicate condition-type))
	   (generate-accessors 0 (field accessor) ...))))))

  (define &condition (@@ (rnrs records procedural) &condition))
  (define &condition-constructor-descriptor
    (make-record-constructor-descriptor &condition #f #f))
  (define condition-internal? (record-predicate &condition))

  (define (condition-predicate rtd)
    (let ((rtd-predicate (record-predicate rtd)))
      (lambda (obj)
	(cond ((compound-condition? obj) 
	       (exists rtd-predicate (simple-conditions obj)))
	      ((condition-internal? obj) (rtd-predicate obj))
	      (else #f)))))

  (define (condition-accessor rtd proc)
    (let ((rtd-predicate (record-predicate rtd)))
      (lambda (obj)
	(cond ((rtd-predicate obj) (proc obj))
	      ((compound-condition? obj) 
	       (and=> (find rtd-predicate (simple-conditions obj)) proc))
	      (else #f)))))

  (define-condition-type &message &condition 
    make-message-condition message-condition? 
    (message condition-message))

  (define-condition-type &warning &condition make-warning warning?)

  (define &serious (@@ (rnrs records procedural) &serious))
  (define make-serious-condition 
    (@@ (rnrs records procedural) make-serious-condition))
  (define serious-condition? (condition-predicate &serious))

  (define-condition-type &error &serious make-error error?)

  (define &violation (@@ (rnrs records procedural) &violation))
  (define make-violation (@@ (rnrs records procedural) make-violation))
  (define violation? (condition-predicate &violation))

  (define &assertion (@@ (rnrs records procedural) &assertion))
  (define make-assertion-violation 
    (@@ (rnrs records procedural) make-assertion-violation))
  (define assertion-violation? (condition-predicate &assertion))

  (define-condition-type &irritants &condition 
    make-irritants-condition irritants-condition?
    (irritants condition-irritants))

  (define-condition-type &who &condition
    make-who-condition who-condition?
    (who condition-who))

  (define-condition-type &non-continuable &violation
    make-non-continuable-violation
    non-continuable-violation?)

  (define-condition-type &implementation-restriction
    &violation
    make-implementation-restriction-violation
    implementation-restriction-violation?)

  (define-condition-type &lexical &violation
    make-lexical-violation lexical-violation?)

  (define-condition-type &syntax &violation
    make-syntax-violation syntax-violation?
    (form syntax-violation-form)
    (subform syntax-violation-subform))

  (define-condition-type &undefined &violation
    make-undefined-violation undefined-violation?)
  
)