summaryrefslogtreecommitdiff
path: root/module/system/base/syntax.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-05-04 13:54:41 +0200
committerAndy Wingo <wingo@pobox.com>2008-05-04 13:54:41 +0200
commitbdaffda2c4dbc14f679bfed0b11e472f7eb64bc5 (patch)
tree7a3c2c80d196416b49bcae4a26aaa870baa1450a /module/system/base/syntax.scm
parentf245e62cf87076c5a77101a509090851ccbd8da5 (diff)
downloadguile-bdaffda2c4dbc14f679bfed0b11e472f7eb64bc5.tar.gz
Define named accessors for legacy record types
* module/system/base/syntax.scm (define-record): Define named accessors, to prepare the code for srfi-9 records switchover. * module/system/il/ghil.scm: * module/system/il/glil.scm: Export a bunch of named accessors.
Diffstat (limited to 'module/system/base/syntax.scm')
-rw-r--r--module/system/base/syntax.scm14
1 files changed, 8 insertions, 6 deletions
diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm
index e379f722e..27baa5558 100644
--- a/module/system/base/syntax.scm
+++ b/module/system/base/syntax.scm
@@ -93,12 +93,14 @@
(and (vector? x) (eq? (vector-ref x 0) ',name)))
,@(do ((n 1 (1+ n))
(slots (cdr def) (cdr slots))
- (ls '() (cons (let* ((slot (car slots))
- (slot (if (pair? slot) (car slot) slot)))
- `(define ,(string->symbol
- (format #f "~A-~A" name n))
- (lambda (x) (slot x ',slot))))
- ls)))
+ (ls '() (append (let* ((slot (car slots))
+ (slot (if (pair? slot) (car slot) slot)))
+ `((define ,(string->symbol
+ (format #f "~A-~A" name n))
+ (lambda (x) (slot x ',slot)))
+ (define ,(symbol-append stem '- slot)
+ (lambda (x) (slot x ',slot)))))
+ ls)))
((null? slots) (reverse! ls))))))
(define (%make-struct args slots)