R6RS records and exports

In this post I asked:

Records conveniently generate a constructure and getters and setters for you.

Is there a way to conveniently export all these generated functions?

I am thinking of generating a helper function so I can copy and paste the exports; this is not ideal of course.

Aziz posted the following solution which works fine on PLT with Andrerui’s fix. I added code to make it in a standard library location:

redefine-record.sls

#!r6rs

;;;; Via comp.lang.scheme "R6RS records and exports"
;;;; By Aziz

;;; redefine-record.sls

(library
 (redefine-record redefine-record)
 (export redefine-record-type)
 (import (rnrs))

 (define-syntax redefine-record-type
   (syntax-rules ()
     [(_ record-name)
      (begin
        (define-syntax m
          (lambda (x)
            (define (fmt s1 stx . s*)
              (datum->syntax stx
                             (string->symbol
                              (apply string-append
                                     s1
                                     (symbol->string (syntax->datum stx))
                                     s*))))
            (define (enumerate i j)
              (if (= i j) '() (cons i (enumerate (+ i 1) j))))
            (syntax-case x ()
              [(_ ctxt)
               (let* ([rtd (record-type-descriptor
                            record-name)]
                      [f* (record-type-field-names rtd)]
                      [rcd (record-constructor-descriptor
                            record-name)])
                 (with-syntax ([make-T (fmt "make-" #'ctxt)]
                               [T? (fmt "" #'ctxt "?")]
                               [(n* (... ...))
                                (enumerate 0 (vector-length f*))]
                               [#(T-ref* (... ...))
                                (vector-map
                                 (lambda (x)
                                   (fmt "" #'ctxt "-" (symbol->string
                                                       x)))
                                 f*)])
                   #'(begin
                       (define make-T
                         (record-constructor
                          (record-constructor-descriptor
                           record-name)))
                       (define T?
                         (record-predicate
                          (record-type-descriptor
                           record-name)))
                       (define T-ref*
                         (record-accessor
                          (record-type-descriptor record-name)
                          n*))
                       (... ...))))])))
        (m record-name))])))

t1.sls

#!r6rs

;;;; Via comp.lang.scheme "R6RS records and exports"
;;;; By Aziz

;;; t1.sls

(library
 (redefine-record t1)
 (export M)
 (import (rnrs))

 (define-record-type M
   (fields x y z)))

t2.ss

#!r6rs

;;;; Via comp.lang.scheme "R6RS records and exports"
;;;; By Aziz and Andreuri

;;; t2.ss

(import (rnrs) (for (redefine-record t1) expand run) (redefine-record redefine-record))

(redefine-record-type M)

(define x (make-M 12 13 14))
(display (list x (M? x) (M-x x)))
(newline)

Run this to see it work:

plt-r6rs t2.sls
=> {#(struct:M 12 13 14) #t 12}