(condition-ref c field)) result)) '() (condition-type-all-fields type)))) (string-join (reverse strings) " "))) (format port "#" (condition-type-id (condition-type c)) (field-values) (number->string (object-address c) 16))) (define (make-condition-type id parent field-names) "Return a new condition type named ID, inheriting from PARENT, and with the fields whose names are listed in FIELD-NAMES. FIELD-NAMES must be a list of symbols and must not contain names already used by PARENT or one of its supertypes." (if (symbol? id) (if (condition-type? parent) (let ((parent-fields (condition-type-all-fields parent))) (if (and (every symbol? field-names) (null? (lset-intersection eq? field-names parent-fields))) (let* ((all-fields (append parent-fields field-names)) (layout (struct-layout-for-condition all-fields))) (%make-condition-type layout id parent all-fields)) (error "invalid condition type field names" field-names))) (error "parent is not a condition type" parent)) (error "condition type identifier is not a symbol" id))) (define (make-compound-condition-type id parents) ;; Return a compound condition type made of the types listed in PARENTS. ;; All fields from PARENTS are kept, even same-named ones, since they are ;; needed by `extract-condition'. (cond ((null? parents) (error "`make-compound-condition-type' passed empty parent list" id)) ((null? (cdr parents)) (car parents)) (else (let* ((all-fields (append-map condition-type-all-fields parents)) (layout (struct-layout-for-condition all-fields))) (%make-condition-type layout id parents ;; list of parents! all-fields)))))