Here is a quick adaptation that uses (Petite) Chez native
records. Just prepend the reference implementation with the following
code, adapted from Mike Sperber's code for MzScheme, which I believe falls
under the LGPL license:
;; Based on original by Mike Sperber, contributed 12/14/2001 to MzScheme.
;; Minor adaptation for Chez Scheme by Andre van Tonder 12/10/2004.
(define-syntax srfi-9:define-record-type
(let ()
(define (filter-map proc l)
(if (null? l)
'()
(let ((result (proc (car l))))
(if result
(cons result (filter-map proc (cdr l)))
(filter-map proc (cdr l))))))
(define (syntax-member? thing stuff)
(cond
((null? stuff) #f)
((free-identifier=? thing (car stuff)) #t)
(else (syntax-member? thing (cdr stuff)))))
(lambda (x)
(syntax-case x ()
((_ type
(constructor constructor-tag ...)
predicate
(field-tag accessor more ...) ...)
(with-syntax
((number-of-fields (length (syntax (field-tag ...))))
((modifier ...)
(filter-map (lambda (descriptor)
(syntax-case descriptor ()
((field-tag accessor) #f)
((field-tag accessor modifier)
(syntax modifier))))
(syntax ((field-tag accessor more ...) ...))))
((constructor-arg ...)
(map (lambda (field-tag)
(if (syntax-member? field-tag
(syntax (constructor-tag ...)))
field-tag
(syntax (void))))
(syntax (field-tag ...))))
(generic-access (syntax generic-access))
(generic-mutate (syntax generic-mutate)))
(with-syntax
(((accessor-proc ...)
(let loop ((i 0)
(fields (syntax (field-tag ...))))
(if (null? fields)
'()
(cons (with-syntax
((i i))
(syntax
(lambda (s)
(generic-access s i))))
(loop (+ 1 i)
(cdr fields))))))
((modifier-proc ...)
(let loop ((i 0)
(descriptors
(syntax ((field-tag accessor more ...) ...))))
(if (null? descriptors)
'()
(syntax-case (car descriptors) ()
((field-tag accessor)
(loop (+ 1 i)
(cdr descriptors)))
((field-tag accessor modifier)
(cons (with-syntax
((i i))
(syntax
(lambda (s v)
(generic-mutate s i v))))
(loop (+ 1 i)
(cdr descriptors)))))))))
(syntax
(begin
(define descriptor (make-record-type ""
'(field-tag ...)))
(define constructor (record-constructor descriptor))
(define predicate (record-predicate descriptor))
(define accessor (record-field-accessor descriptor 'field-tag))
...
(define modifier (record-field-mutator descriptor 'field-tag))
...)))))))))