ERR5RS Records
William D Clinger
This SRFI is currently in ``draft'' status. To see an explanation of
each status that a SRFI can hold, see here.
To provide input on this SRFI, please
mail to
<srfi minus 99 at srfi dot schemers dot org>. See
instructions here to subscribe to
the list. You can access previous messages via
the archive of the mailing list.
Many Scheme programmers have considered records to be one of the most important features missing from the R5RS. The R6RS proposed a record system, but its design has been widely criticized and it was not intended for use in R5RS programs anyway.
This SRFI proposes a better record system for use in R5RS, ERR5RS, and R6RS programs. The syntactic layer of this SRFI's record system is an extension of SRFI 9. The procedural and inspection layers of this SRFI's record system are perfectly compatible with its syntactic layer. This entire SRFI is compatible with the procedural and inspection layers of the R6RS record system, but offers several worthwhile improvements over the R6RS system.
This SRFI's proposed answers to the following questions are indicated within parentheses.
make-record-constructor-descriptor
procedure of the R6RS. Larceny, for example, allows that
procedure to be used with ERR5RS record type descriptors.)
make-rtd procedure, the succinct
identifier-only field spec implies mutability.
The define-record-type syntax provides
succinct abbreviations for both immutable and mutable
fields.)
This draft has not yet been submitted to the SRFI editors.
In most programming languages, records (aka structures or classes) are important because they can package component values of different types into a single object.
Scheme's vectors and procedures provided that capability already, but records remained important for two reasons:
For many programmers, records were the most important new feature of the R6RS, but the specific record systems that were proposed by the R6RS have been widely criticized. Over 30% of those who voted against ratification mentioned the record systems as one of their reasons. [1]
To improve upon this unsatisfactory outcome, we should first understand how it happened.
The importance of adding records to Scheme has been
recognized for more than twenty years.
[2]
The basic idea behind the SRFI 9 and R6RS record systems
was outlined by Norman Adams on 8 July 1987, following
similar ideas that had been implemented in T and MIT CScheme.
[3]
Jonathan Rees posted a revision of Adams's proposal on
26 May 1988.
[4]
Pavel Curtis proposed an extension of Rees's proposal
on 18 August 1989, noting that it had been approved by
consensus at the first meeting of BASH (Bay Area Scheme
Hackers?).
[5]
The rrrs-authors archive includes several responses to
these proposals that are worth reading.
The Rees/Curtis proposal was revived in 1992. [6] When the RnRS authors met on 25 June 1992 in Palo Alto, they felt that this proposal needed more discussion. [7] Kent Dybvig objected to the proposal on several grounds, including the provision of inspection facilities, the inability to define immutable records, and the use of procedures instead of special forms. Although 9 authors favored adoption of the records proposal, 11 opposed it.
The topic of records was revived again on 23 April 1996 by Bruce Duba, Matthew Flatt, and Shriram Krishnamurthi. [8] Alan Bawden and Richard Kelsey observed that the Duba/Flatt/Krishnamurthi proposal was essentially the same as Pavel Curtis's, which Kelsey reposted. Kent Dybvig objected once again, on the same three grounds, arguing (incorrectly) that procedural interfaces are difficult to compile efficiently, and concluding (incorrectly) that this alleged inefficiency would create portability problems. [9]
On 24 April 1996, Bill Rozas suggested the idea of having two separate APIs, one procedural and one syntactic, for the same record facility. [10] Two days later, Dybvig proposed a "compromise" along those lines [11] that incorporated several artificial restrictions, apparently because Dybvig feared his compiler would be unable to generate efficient code for the general case. [12]
SRFI 9, submitted by Richard Kelsey in July 1999, is a syntactic API in the tradition of the Rees, Curtis, and Duba/Flatt/Krishnamurthi proposals. [13]
Single inheritance was added by Larceny in 1998, and by Chez Scheme in 1999. [14]
SRFI 57, submitted by Andre van Tonder in September 2004, features label polymorphism, which can be considered a form of structural subtyping and multiple inheritance. [15]
The R6RS proposes a three-layer single inheritance system, with syntactic, procedural, and inspection layers. [16] The R6RS procedural layer generally requires at least three separate definitions for each level of inheritance: the record-type descriptor, at least one record-constructor descriptor, and an actual constructor (if instances of the record-type are to be created).
Some attempts have been made to justify the complexity of the R6RS procedural layer by claiming that hardly anyone would actually use it; programmers who try to use the procedural layer would presumably give up in frustration and use the syntactic interface instead. Meanwhile, gratuitous design errors impede interoperation between procedural and syntactic layers, and several bogus claims about the inefficiency of higher order procedures were inserted into the very last public draft and were then ratified as part of the R6RS. [17]
When it comes to records, there is no good reason for ERR5RS records or other SRFIs to strive for full bug-compatibility with the R6RS. Fortunately, it is possible to design good APIs for records that interoperate well with the R6RS's procedural and inspection layers, even though the better APIs may differ from the R6RS APIs in several important respects.
It is not possible to design APIs that interoperate well with both the R6RS syntactic and procedural layers, because the R6RS syntactic layer uses a fundamentally different notion of record type than the R6RS procedural layer. On the other hand, it is not hard to design a syntactic API that interoperates with the R6RS APIs at least as well as the R6RS APIs interoperate with each other.
The ERR5RS syntactic layer is therefore based upon the Rees/Curtis/Duba/Flatt/Krishnamurthi/Kelsey/SRFI-9 tradition, changing only a few details to improve interoperability with records defined by the ERR5RS and R6RS procedural layers.
The record system described by this SRFI has been
implemented in Larceny. It is the primary record
system used by Larceny's implementation of the R6RS,
including the (rnrs records syntactic)
library. Larceny demonstrates both the efficiency
of ERR5RS records and the ease of interoperability
between SRFI 9, ERR5RS, and the procedural and
inspection layers of R6RS records.
The specification is divided into three layers, which correspond to the following standard libraries of ERR5RS:
(err5rs records procedural)(err5rs records inspection)(err5rs records syntactic)The specification also describes how Scheme's standard equivalence predicates behave with respect to records, and shows how some R6RS examples can be translated to use the ERR5RS libraries instead.
When the following specification says that a procedure is said to be equivalent to some R6RS procedure, the equivalence holds only when all arguments have the properties required of them by the R6RS specification. ERR5RS does not mandate the R6RS exception semantics for programs that violate the specification.
(make-rtd name fieldspecs)
(make-rtd name fieldspecs parent)
name is a symbol, which matters only to the
rtd-name procedure of the inspection layer.
fieldspecs is a vector of field specifiers, where
each field specifier is one of
(mutable name),
where name is a symbol naming the mutable field;(immutable name),
where name is a symbol naming the immutable field.
The optional parent is an rtd or #f.
It is an error for any of the symbols in fieldspecs to
name more than one of the fields specified by fieldspecs,
but the field names in fieldspecs may shadow field names
in the parent record-type.
Implementations may wish to extend this procedure to support the non-generative, sealed, and/or opaque features of the R6RS. The recommended way to support those features is to allow any combination of the following arguments to follow the optional parent argument:
sealed means the new rtd cannot
be used as the parent of other rtds.opaque means the record?
predicate will not recognize instances of the new rtd.uid, following by another symbol
id, means the new rtd is non-generative with uid id.
The semantics of this extension is the same as described by the
R6RS.Returns an R6RS-compatible record-type descriptor. Could be defined (without the recommended error checking, and without the extensions described above) in terms of the R6RS procedural layer by
(define (make-rtd name fieldspecs . rest)
(make-record-type-descriptor
name
(if (null? rest) #f (car rest))
#f #f #f
(vector-map (lambda (fieldspec)
(if (symbol? fieldspec)
(list 'mutable fieldspec)
fieldspec))
fieldspecs)))
(rtd? obj)
Equivalent to the record-type-descriptor?
procedure of the R6RS.
(rtd-constructor rtd)
(rtd-constructor rtd fieldspecs)
rtd is a record-type descriptor, and fieldspecs is an optional vector of symbols.
If no fieldspecs argument is supplied, then
rtd-constructor returns a procedure
that expects one argument for each field of the
record-type described by rtd and returns an
instance of that record-type with its fields
initialized to the corresponding arguments.
Arguments that correspond to the fields of the
record-type's parent (if any) come first.
If fieldspecs is supplied, then
rtd-constructor returns a procedure
that expects one argument for each element of
fieldspecs and returns an instance of the
record-type described by rtd with the named
fields initialized to the corresponding arguments.
It is an error if some symbol occurs more than once in fieldspecs. Fields of a derived record-type shadow fields of the same name in its parent; the fieldspecs argument cannot be used to initialize a shadowed field.
Note: The optional second argument was proposed by Pavel Curtis, and interoperates well with SRFI 9.
Could be defined in terms of the R6RS procedural layer and ERR5RS inspection layer by:
(define (rtd-constructor rtd . rest)
; Computes permutation and allocates permutation buffer
; when the constructor is created, not when the constructor
; is called. More error checking is recommended.
(define (make-constructor fieldspecs allnames maker)
(let* ((k (length fieldspecs))
(n (length allnames))
(buffer (make-vector n 'some-unspecified-value))
(reverse-all-names (reverse allnames)))
(define (position fieldname)
(let ((names (memq fieldname reverse-all-names)))
(assert names)
(- (length names) 1)))
(let ((indexes (map position fieldspecs)))
; The following can be made quite efficient by
; hand-coding it in some lower-level language,
; e.g. Larceny's mal. Even case-lambda would
; be good enough in most systems.
(lambda args
(assert (= (length args) k))
(for-each (lambda (arg posn)
(vector-set! buffer posn arg))
args indexes)
(apply maker (vector->list buffer))))))
(if (null? rest)
(record-constructor
(make-record-constructor-descriptor rtd #f #f))
(begin (assert (null? (cdr rest)))
(make-constructor
(vector->list (car rest))
(vector->list (record-type-all-field-names rtd))
(record-constructor
(make-record-constructor-descriptor rtd #f #f))))))
(rtd-predicate rtd)
Equivalent to the record-predicate procedure of the R6RS.
(rtd-accessor rtd field)
field is a symbol that names a field of the record-type described by the record-type descriptor rtd. Returns a unary procedure that accepts instances of rtd (or any record-type that inherits from rtd) and returns the current value of the named field.
Fields in derived record-types shadow fields of the same name in a parent record-type.
(rtd-mutator rtd field)
field is a symbol that names a field of the record-type described by the record-type descriptor rtd. Returns a binary procedure that accepts instances of rtd (or any record-type that inherits from rtd) and a new value to be stored into the named field, performs that side effect, and returns an unspecified value.
Fields in derived record-types shadow fields of the same name in a parent record-type.
When a procedure is said to be equivalent to an R6RS procedure, the equivalence holds only when all arguments have the properties required of them by the R6RS specification. ERR5RS does not mandate the R6RS exception semantics for programs that violate the specification.
(record? obj)
Equivalent to its R6RS namesake.
(record-rtd record)
Equivalent to its R6RS namesake.
(rtd-name rtd)
Equivalent to the record-type-name procedure of the R6RS.
(rtd-parent rtd)
Equivalent to the record-type-parent procedure of the R6RS.
(rtd-field-names rtd)
Equivalent to the record-type-field-names
procedure of the R6RS. (That is, it returns
a vector of the symbols that name the fields of the
record-type represented by rtd, excluding
the fields of parent record-types.)
(rtd-all-field-names rtd)
Returns a vector of the symbols that name the fields
of the record-type represented by rtd, including
the fields of its parent record-types, if any.
The fields of parent record-types come before the
fields of its children, with each subsequence in the
same order as in the vectors that would be returned
by calling rtd-field-names on rtd
and on all its ancestral record-type descriptors.
Could be defined by
(define (rtd-all-field-names rtd)
(define (loop rtd othernames)
(let ((parent (rtd-parent rtd))
(names (append (vector->list
(rtd-field-names rtd))
othernames)))
(if parent
(loop parent names)
(list->vector names))))
(loop rtd '()))
(rtd-field-mutable? rtd field)
rtd is a record-type descriptor, and field
is a symbol naming a field of the record-type
described by rtd. Returns #t
if the named field is mutable; otherwise returns
#f.
The syntactic layer consists of SRFI 9 extended with single inheritance and (optional) implicit naming.
All ERR5RS record-type definitions are generative, but ERR5RS drops the SRFI 9 restriction to top level, mainly because the R6RS allows generative definitions wherever a definition may appear.
The syntax of an ERR5RS record-type definition is
<definition>
-> <record type definition> ; addition to 7.1.6 in R5RS
<record type definition>
-> (define-record-type <type spec>
<constructor spec>
<predicate spec>
<field spec> ...)
<type spec> -> <type name>
-> (<type name> <parent>)
<constructor spec>
-> #f
-> #t
-> <constructor name>
-> (<constructor name> <field name> ...)
<predicate spec>
-> #f
-> #t
-> <predicate name>
<field spec> -> <field name>
-> (<field name>)
-> (<field name> <accessor name>)
-> (<field name> <accessor name> <mutator name>)
<parent> -> <expression>
<type name> -> <identifier>
<constructor name> -> <identifier>
<predicate name> -> <identifier>
<accessor name> -> <identifier>
<mutator name> -> <identifier>
<field name> -> <identifier>
The semantics of a record type definition is the same as in SRFI 9: the record type definition macro-expands into a cluster of definitions that
<type name> as the
record-type descriptor for the new record-type;
#f);
#f);
An ERR5RS record type definition extends SRFI 9 with the following additional options:
<parent> expression is specified,
then it must evaluate to an rtd that serves as the parent
record-type for the record-type being defined.
#f is specified for the constructor or
predicate, then no constructor or predicate procedure is defined.
(This is useful when the record-type being defined will be used
as an abstract base class.)
#t is specified for the constructor or
predicate, then the name of the constructor is the type name
prefixed by make-, and the name of the predicate
is the type name followed by a question mark (?).
#t or
as an identifier, then the constructor's arguments correspond
to the fields of the parent (if any) followed by the new fields
added by this record-type definition.
-) followed by the field name.
-) followed by the field name;
-) followed by the field name
followed by -set!.
Two ERR5RS records with fields are eqv?
if and only if they were created by the same (dynamic)
call to some record constructor. Two ERR5RS records
are eq? if and only if they are
eqv?. Two ERR5RS records
are equal? if and only if they are
eqv?.
equal? behave the same as eqv?.)
A define-record-type form macro-expands
into code that calls make-rtd each time
the expanded record-type definition is executed.
Two ERR5RS record-type descriptors are eqv?
if and only if they were created by the same (dynamic)
call to make-rtd.
R6RS library section 6.3 includes two extended examples that provide a nice comparison of the R6RS and ERR5RS record systems, especially since these two examples were designed to highlight the use of R6RS record-constructor descriptors in combination with inheritance.
Using ERR5RS records, the first example becomes:
(define rtd1
(make-rtd 'rtd1 '#((immutable x1) (immutable x2))))
(define rtd2
(make-rtd 'rtd2 '#((immutable x3) (immutable x4)) rtd1))
(define rtd3
(make-rtd 'rtd3 '#((immutable x5) (immutable x6)) rtd2))
(define protocol1
(lambda (p)
(lambda (a b c)
(p (+ a b) (+ b c)))))
(define protocol2
(lambda (n)
(lambda (a b c d e f)
(let ((p (n a b c)))
(p (+ d e) (+ e f))))))
(define protocol3
(lambda (n)
(lambda (a b c d e f g h i)
(let ((p (n a b c d e f)))
(p (+ g h) (+ h i))))))
(define make-rtd1
(protocol1 (rtd-constructor rtd1)))
(define make-rtd2
(let ((maker2 (rtd-constructor rtd2)))
(protocol2
(protocol1
(lambda (x1 x2)
(lambda (x3 x4)
(maker2 x1 x2 x3 x4)))))))
(define make-rtd3
(let ((maker3 (rtd-constructor rtd3)))
(protocol3
(protocol2
(protocol1
(lambda (x1 x2)
(lambda (x3 x4)
(lambda (x5 x6)
(maker3 x1 x2 x3 x4 x5 x6)))))))))
(make-rtd3 1 2 3 4 5 6 7 8 9)
; evaluates to a record whose fields contain
; 3 5 9 11 15 17
The purpose of the R6RS record-constructor descriptors is to
automate the idiom shown in the definitions of
make-rtd1, make-rtd2,
and make-rtd3 above, and to provide an alternative
to procedural abstraction when eliminating the duplication of
code seen in make-point/abs and
make-cpoint/abs below.
The second example illustrates the shadowing of fields in a parent record-type by fields in a derived record-type. Using ERR5RS records, the second example becomes:
(define :point
(make-rtd 'point '#((mutable x) (mutable y))))
(define make-point (rtd-constructor :point))
(define point? (rtd-predicate :point))
(define point-x (rtd-accessor :point 'x))
(define point-y (rtd-accessor :point 'y))
(define point-x-set! (rtd-mutator :point 'x))
(define point-y-set! (rtd-mutator :point 'y))
(define p1 (make-point 1 2))
(point? p1) => #t
(point-x p1) => 1
(point-y p1) => 2
(point-x-set! p1 5)
(point-x p1) => 5
(define :point2
(make-rtd 'point2 '#((mutable x) (mutable y)) :point))
(define make-point2
(rtd-constructor :point2))
(define point2? (rtd-predicate :point2))
(define point2-xx (rtd-accessor :point2 'x))
(define point2-yy (rtd-accessor :point2 'y))
(define p2 (make-point2 1 2 3 4))
(point? p2) => #t
(point-x p2) => 1
(point-y p2) => 2
(point2-xx p2) => 3
(point2-yy p2) => 4
(define make-point/abs
(let ((maker (rtd-constructor :point)))
(lambda (x y)
(maker (abs x) (abs y)))))
(point-x (make-point/abs -1 -2)) => 1
(point-y (make-point/abs -1 -2)) => 2
(define :cpoint
(make-rtd 'cpoint '#((mutable rgb)) :point))
(define make-cpoint
(let ((maker (rtd-constructor :cpoint)))
(lambda (x y c)
(maker x y (color->rgb c)))))
(define make-cpoint/abs
(let ((maker (rtd-constructor :cpoint)))
(lambda (x y c)
(maker (abs x) (abs y) (color->rgb c)))))
(define cpoint-rgb
(rtd-accessor :cpoint 'rgb))
(define (color->rgb c)
(cons 'rgb c))
(cpoint-rgb (make-cpoint -1 -3 'red)) => (rgb . red)
(point-x (make-cpoint -1 -3 'red)) => -1
(point-x (make-cpoint/abs -1 -3 'red)) => 1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; ERR5RS Records.
;
; This is a quick-and-dirty reference implementation that favors
; simplicity over quality error messages and performance. It is
; implemented using the R6RS procedural and inspection layers,
; with which it interoperates nicely.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This library breaks a circular interdependence between the
; procedural and inspection layers.
(library (err5rs-helpers records rtd?)
(export rtd?)
(import (rnrs base) (rnrs records procedural))
(define rtd? record-type-descriptor?)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (err5rs records inspection)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(library (err5rs records inspection)
(export record? record-rtd
rtd-name rtd-parent
rtd-field-names rtd-all-field-names rtd-field-mutable?)
(import (rnrs base)
(rnrs lists)
(rnrs records inspection)
(err5rs-helpers records rtd?))
; The record? predicate is already defined by (rnrs records inspection).
; The record-rtd procedure is already defined by (rnrs records inspection).
(define rtd-name record-type-name)
(define rtd-parent record-type-parent)
(define rtd-field-names record-type-field-names)
(define (rtd-all-field-names rtd)
(define (loop rtd othernames)
(let ((parent (rtd-parent rtd))
(names (append (vector->list
(rtd-field-names rtd))
othernames)))
(if parent
(loop parent names)
(list->vector names))))
(loop rtd '()))
(define (rtd-field-mutable? rtd0 fieldname)
(define (loop rtd)
(if (rtd? rtd)
(let* ((names (vector->list (rtd-field-names rtd)))
(probe (memq fieldname names)))
(if probe
(record-field-mutable? rtd (- (length names) (length probe)))
(loop (rtd-parent rtd))))
(assertion-violation 'rtd-field-mutable?
"illegal argument" rtd0 fieldname)))
(loop rtd0))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; (err5rs records procedural)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(library (err5rs records procedural)
(export make-rtd rtd? rtd-constructor
rtd-predicate rtd-accessor rtd-mutator)
(import (rnrs base)
(rnrs lists)
(rnrs records procedural)
(err5rs records inspection))
; Note: the options are permitted by ERR5RS,
; but are not part of ERR5RS.
(define (make-rtd name fieldspecs . rest)
(let* ((parent (if (null? rest) #f (car rest)))
(options (if (null? rest) '() (cdr rest)))
(sealed? (and (memq 'sealed options) #t))
(opaque? (and (memq 'opaque options) #t))
(uid (let ((probe (memq 'uid options)))
(if (and probe (not (null? (cdr probe))))
(cadr probe)
#f))))
(make-record-type-descriptor
name
parent
uid
sealed?
opaque?
(vector-map (lambda (fieldspec)
(if (symbol? fieldspec)
(list 'mutable fieldspec)
fieldspec))
fieldspecs))))
(define rtd? record-type-descriptor?)
(define (rtd-constructor rtd . rest)
; Computes permutation and allocates permutation buffer
; when the constructor is created, not when the constructor
; is called. More error checking is recommended.
(define (make-constructor fieldspecs allnames maker)
(let* ((k (length fieldspecs))
(n (length allnames))
(buffer (make-vector n))
(reverse-all-names (reverse allnames)))
(define (position fieldname)
(let ((names (memq fieldname reverse-all-names)))
(assert names)
(- (length names) 1)))
(let ((indexes (map position fieldspecs)))
; The following can be made quite efficient by
; hand-coding it in some lower-level language,
; e.g. Larceny's mal. Even case-lambda would
; be good enough in most systems.
(lambda args
(assert (= (length args) k))
(for-each (lambda (arg posn)
(vector-set! buffer posn arg))
args indexes)
(apply maker (vector->list buffer))))))
(if (null? rest)
(record-constructor
(make-record-constructor-descriptor rtd #f #f))
(begin (assert (null? (cdr rest)))
(make-constructor
(vector->list (car rest))
(vector->list (rtd-all-field-names rtd))
(record-constructor
(make-record-constructor-descriptor rtd #f #f))))))
(define rtd-predicate record-predicate)
(define (rtd-accessor rtd0 fieldname)
(define (loop rtd)
(if (rtd? rtd)
(let* ((names (vector->list (rtd-field-names rtd)))
(probe (memq fieldname names)))
(if probe
(record-accessor rtd (- (length names) (length probe)))
(loop (rtd-parent rtd))))
(assertion-violation 'rtd-accessor
"illegal argument" rtd0 fieldname)))
(loop rtd0))
(define (rtd-mutator rtd0 fieldname)
(define (loop rtd)
(if (rtd? rtd)
(let* ((names (vector->list (rtd-field-names rtd)))
(probe (memq fieldname names)))
(if probe
(record-mutator rtd (- (length names) (length probe)))
(loop (rtd-parent rtd))))
(assertion-violation 'rtd-mutator
"illegal argument" rtd0 fieldname)))
(loop rtd0))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; ERR5RS records, syntactic layer.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(library (err5rs records syntactic)
(export define-record-type)
(import (for (rnrs base) run expand)
(for (rnrs lists) run expand)
(for (rnrs syntax-case) run expand)
(err5rs records procedural))
(define-syntax define-record-type
(syntax-rules ()
((_ (type-name parent) constructor-spec predicate-spec . field-specs)
(define-record-type-helper0
type-name parent constructor-spec predicate-spec . field-specs))
((_ type-name constructor-spec predicate-spec . field-specs)
(define-record-type-helper0
type-name #f constructor-spec predicate-spec . field-specs))))
(define-syntax define-record-type-helper0
(lambda (x)
(define (complain)
(syntax-violation 'define-record-type "illegal syntax" x))
(syntax-case x ()
((_ tname pname constructor-spec predicate-spec . field-specs)
(let* ((type-name (syntax->datum #'tname))
(parent (syntax->datum #'pname))
(cspec (syntax->datum #'constructor-spec))
(pspec (syntax->datum #'predicate-spec))
(fspecs (syntax->datum #'field-specs))
(type-name-string
(begin (if (not (symbol? type-name))
(complain))
(symbol->string type-name)))
(constructor-name
(cond ((eq? cspec #f)
#f)
((eq? cspec #t)
(string->symbol
(string-append "make-" type-name-string)))
((symbol? cspec)
cspec)
((pair? cspec)
(car cspec))
(else (complain))))
(constructor-args
(cond ((pair? cspec)
(if (not (for-all symbol? cspec))
(complain)
(list->vector (cdr cspec))))
(else #f)))
(predicate-name
(cond ((eq? pspec #f)
#f)
((eq? pspec #t)
(string->symbol
(string-append type-name-string "?")))
((symbol? pspec)
pspec)
(else (complain))))
(field-specs
(map (lambda (fspec)
(cond ((symbol? fspec)
(list 'immutable
fspec
(string->symbol
(string-append
type-name-string
"-"
(symbol->string fspec)))))
((not (pair? fspec))
(complain))
((not (list? fspec))
(complain))
((not (for-all symbol? fspec))
(complain))
((null? (cdr fspec))
(list 'mutable
(car fspec)
(string->symbol
(string-append
type-name-string
"-"
(symbol->string (car fspec))))
(string->symbol
(string-append
type-name-string
"-"
(symbol->string (car fspec))
"-set!"))))
((null? (cddr fspec))
(list 'immutable
(car fspec)
(cadr fspec)))
((null? (cdddr fspec))
(cons 'mutable fspec))
(else (complain))))
fspecs))
(fields (list->vector (map cadr field-specs)))
(accessor-fields
(map (lambda (x) (list (caddr x) (cadr x)))
(filter (lambda (x) (>= (length x) 3))
field-specs)))
(mutator-fields
(map (lambda (x) (list (cadddr x) (cadr x)))
(filter (lambda (x) (= (length x) 4))
field-specs))))
(datum->syntax
#'tname
`(,#'define-record-type-helper
,type-name ,fields ,parent
,(if constructor-args
(list constructor-name constructor-args)
constructor-name)
,predicate-name
,accessor-fields ,mutator-fields)))))))
(define-syntax define-record-type-helper
(syntax-rules ()
((_ type-name fields parent #f predicate
((accessor field) ...) ((mutator mutable-field) ...))
(define-record-type-helper
type-name fields parent ignored predicate
((accessor field) ...) ((mutator mutable-field) ...)))
((_ type-name fields parent constructor #f
((accessor field) ...) ((mutator mutable-field) ...))
(define-record-type-helper
type-name fields parent constructor ignored
((accessor field) ...) ((mutator mutable-field) ...)))
((_ type-name fields parent (constructor args) predicate
((accessor field) ...) ((mutator mutable-field) ...))
(begin (define type-name (make-rtd 'type-name 'fields parent))
(define constructor (rtd-constructor type-name 'args))
(define predicate (rtd-predicate type-name))
(define accessor (rtd-accessor type-name 'field))
...
(define mutator (rtd-mutator type-name 'mutable-field))
...))
((_ type-name fields parent constructor predicate
((accessor field) ...) ((mutator mutable-field) ...))
(begin (define type-name (make-rtd 'type-name 'fields parent))
(define constructor (rtd-constructor type-name))
(define predicate (rtd-predicate type-name))
(define accessor (rtd-accessor type-name 'field))
...
(define mutator (rtd-mutator type-name 'mutable-field))
...))))
) ; err5rs records syntactic
I am grateful to David Rush and Andre van Tonder for their comments and criticisms, as well as to all those mentioned by name in the Rationale. The reference implementation is from Larceny v0.96.
Copyright (C) William D Clinger 2008. All Rights Reserved.
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. REMEMBER, THERE IS NO SCHEME UNDERGROUND. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.