mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 18:20:22 +02:00
Code Activity

Define named accessors for legacy record types

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2008-05-04 13:54:41 +02:00
parent f245e62cf8
commit bdaffda2c4
3 changed files with 37 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/system/base/syntax.scm
View file

@ -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)