diff options
author | Andy Wingo <wingo@pobox.com> | 2008-05-04 13:54:41 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-05-04 13:54:41 +0200 |
commit | bdaffda2c4dbc14f679bfed0b11e472f7eb64bc5 (patch) | |
tree | 7a3c2c80d196416b49bcae4a26aaa870baa1450a /module/system/base/syntax.scm | |
parent | f245e62cf87076c5a77101a509090851ccbd8da5 (diff) | |
download | guile-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.scm | 14 |
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) |