summaryrefslogtreecommitdiff
path: root/module/rnrs/conditions.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/rnrs/conditions.scm')
-rw-r--r--module/rnrs/conditions.scm27
1 files changed, 10 insertions, 17 deletions
diff --git a/module/rnrs/conditions.scm b/module/rnrs/conditions.scm
index 959411b9e..fa2ed6782 100644
--- a/module/rnrs/conditions.scm
+++ b/module/rnrs/conditions.scm
@@ -125,13 +125,7 @@
((_ condition-type supertype constructor predicate
(field accessor) ...)
(letrec-syntax
- ((transform-fields
- (syntax-rules ()
- ((_ (f a) . rest)
- (cons '(immutable f a) (transform-fields . rest)))
- ((_) '())))
-
- (generate-accessors
+ ((generate-accessors
(syntax-rules ()
((_ counter (f a) . rest)
(begin (define a
@@ -140,16 +134,15 @@
(record-accessor condition-type counter)))
(generate-accessors (+ counter 1) . rest)))
((_ counter) (begin)))))
- (begin
- (define condition-type
- (make-record-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-type
+ (make-record-type-descriptor
+ 'condition-type supertype #f #f #f
+ '#((immutable field) ...)))
+ (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