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}

Leave a Reply

Your email address will not be published. Required fields are marked *