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

Merge remote-tracking branch 'origin/stable-2.0'

Browse source
This commit is contained in:
Mark H Weaver 2012-11-10 19:17:30 -05:00
commit db18a252fb
8 changed files with 454 additions and 158 deletions
Download patch file Download diff file Expand all files Collapse all files

253
doc/ref/api-compound.texi
View file

@ -25,8 +25,10 @@ values can be looked up within them.
* Generalized Vectors:: Treating all vector-like things uniformly.
* Arrays:: Matrices, etc.
* VLists:: Vector-like lists.
* Records::
* Structures::
* Record Overview:: Walking through the maze of record APIs.
* SRFI-9 Records:: The standard, recommended record API.
* Records:: Guile's historical record API.
* Structures:: Low-level record representation.
* Dictionary Types:: About dictionary types in general.
* Association Lists:: List-based dictionaries.
* VHashes:: VList-based dictionaries.
@ -2249,7 +2251,254 @@ Return a new vlist whose contents correspond to @var{lst}.
Return a new list whose contents match those of @var{vlist}.
@end deffn
@node Record Overview
@subsection Record Overview
@cindex record
@cindex structure
@dfn{Records}, also called @dfn{structures}, are Scheme's primary
mechanism to define new disjoint types. A @dfn{record type} defines a
list of @dfn{fields} that instances of the type consist of. This is like
C's @code{struct}.
Historically, Guile has offered several different ways to define record
types and to create records, offering different features, and making
different trade-offs. Over the years, each ``standard'' has also come
with its own new record interface, leading to a maze of record APIs.
At the highest level is SRFI-9, a high-level record interface
implemented by most Scheme implementations (@pxref{SRFI-9}). It defines
a simple and efficient syntactic abstraction of record types and their
associated type predicate, fields, and field accessors. SRFI-9 is
suitable for most uses, and this is the recommended way to create record
types in Guile. Similar high-level record APIs include SRFI-35
(@pxref{SRFI-35}) and R6RS records (@pxref{rnrs records syntactic}).
Then comes Guile's historical ``records'' API (@pxref{Records}). Record
types defined this way are first-class objects. Introspection
facilities are available, allowing users to query the list of fields or
the value of a specific field at run-time, without prior knowledge of
the type.
Finally, the common denominator of these interfaces is Guile's
@dfn{structure} API (@pxref{Structures}). Guile's structures are the
low-level building block for all other record APIs. Application writers
will normally not need to use it.
Records created with these APIs may all be pattern-matched using Guile's
standard pattern matcher (@pxref{Pattern Matching}).
@node SRFI-9 Records
@subsection SRFI-9 Records
@cindex SRFI-9
@cindex record
SRFI-9 standardizes a syntax for defining new record types and creating
predicate, constructor, and field getter and setter functions. In Guile
this is the recommended option to create new record types (@pxref{Record
Overview}). It can be used with:
@example
(use-modules (srfi srfi-9))
@end example
@deffn {library syntax} define-record-type type @* (constructor fieldname @dots{}) @* predicate @* (fieldname accessor [modifier]) @dots{}
@sp 1
Create a new record type, and make various @code{define}s for using
it. This syntax can only occur at the top-level, not nested within
some other form.
@var{type} is bound to the record type, which is as per the return
from the core @code{make-record-type}. @var{type} also provides the
name for the record, as per @code{record-type-name}.
@var{constructor} is bound to a function to be called as
@code{(@var{constructor} fieldval @dots{})} to create a new record of
this type. The arguments are initial values for the fields, one
argument for each field, in the order they appear in the
@code{define-record-type} form.
The @var{fieldname}s provide the names for the record fields, as per
the core @code{record-type-fields} etc, and are referred to in the
subsequent accessor/modifier forms.
@var{predicate} is bound to a function to be called as
@code{(@var{predicate} obj)}. It returns @code{#t} or @code{#f}
according to whether @var{obj} is a record of this type.
Each @var{accessor} is bound to a function to be called
@code{(@var{accessor} record)} to retrieve the respective field from a
@var{record}. Similarly each @var{modifier} is bound to a function to
be called @code{(@var{modifier} record val)} to set the respective
field in a @var{record}.
@end deffn
@noindent
An example will illustrate typical usage,
@example
(define-record-type employee-type
(make-employee name age salary)
employee?
(name get-employee-name)
(age get-employee-age set-employee-age)
(salary get-employee-salary set-employee-salary))
@end example
This creates a new employee data type, with name, age and salary
fields. Accessor functions are created for each field, but no
modifier function for the name (the intention in this example being
that it's established only when an employee object is created). These
can all then be used as for example,
@example
employee-type @result{} #<record-type employee-type>
(define fred (make-employee "Fred" 45 20000.00))
(employee? fred) @result{} #t
(get-employee-age fred) @result{} 45
(set-employee-salary fred 25000.00) ;; pay rise
@end example
The functions created by @code{define-record-type} are ordinary
top-level @code{define}s. They can be redefined or @code{set!} as
desired, exported from a module, etc.
@unnumberedsubsubsec Non-toplevel Record Definitions
The SRFI-9 specification explicitly disallows record definitions in a
non-toplevel context, such as inside @code{lambda} body or inside a
@var{let} block. However, Guile's implementation does not enforce that
restriction.
@unnumberedsubsubsec Custom Printers
You may use @code{set-record-type-printer!} to customize the default printing
behavior of records. This is a Guile extension and is not part of SRFI-9. It
is located in the @nicode{(srfi srfi-9 gnu)} module.
@deffn {Scheme Syntax} set-record-type-printer! name thunk
Where @var{type} corresponds to the first argument of @code{define-record-type},
and @var{thunk} is a procedure accepting two arguments, the record to print, and
an output port.
@end deffn
@noindent
This example prints the employee's name in brackets, for instance @code{[Fred]}.
@example
(set-record-type-printer! employee-type
(lambda (record port)
(write-char #\[ port)
(display (get-employee-name record) port)
(write-char #\] port)))
@end example
@unnumberedsubsubsec Functional ``Setters''
@cindex functional setters
When writing code in a functional style, it is desirable to never alter
the contents of records. For such code, a simple way to return new
record instances based on existing ones is highly desirable.
The @code{(srfi srfi-9 gnu)} module extends SRFI-9 with facilities to
return new record instances based on existing ones, only with one or
more field values changed---@dfn{functional setters}. First, the
@code{define-immutable-record-type} works like
@code{define-record-type}, except that fields are immutable and setters
are defined as functional setters.
@deffn {Scheme Syntax} define-immutable-record-type type @* (constructor fieldname @dots{}) @* predicate @* (fieldname accessor [modifier]) @dots{}
Define @var{type} as a new record type, like @code{define-record-type}.
However, the record type is made @emph{immutable} (records may not be
mutated, even with @code{struct-set!}), and any @var{modifier} is
defined to be a functional setter---a procedure that returns a new
record instance with the specified field changed, and leaves the
original unchanged (see example below.)
@end deffn
@noindent
In addition, the generic @code{set-field} and @code{set-fields} macros
may be applied to any SRFI-9 record.
@deffn {Scheme Syntax} set-field (field sub-fields ...) record value
Return a new record of @var{record}'s type whose fields are equal to
the corresponding fields of @var{record} except for the one specified by
@var{field}.
@var{field} must be the name of the getter corresponding to the field of
@var{record} being ``set''. Subsequent @var{sub-fields} must be record
getters designating sub-fields within that field value to be set (see
example below.)
@end deffn
@deffn {Scheme Syntax} set-fields record ((field sub-fields ...) value) ...
Like @code{set-field}, but can be used to set more than one field at a
time. This expands to code that is more efficient than a series of
single @code{set-field} calls.
@end deffn
To illustrate the use of functional setters, let's assume these two
record type definitions:
@example
(define-record-type <address>
(address street city country)
address?
(street address-street)
(city address-city)
(country address-country))
(define-immutable-record-type <person>
(person age email address)
person?
(age person-age set-person-age)
(email person-email set-person-email)
(address person-address set-person-address))
@end example
@noindent
First, note that the @code{<person>} record type definition introduces
named functional setters. These may be used like this:
@example
(define fsf-address
(address "Franklin Street" "Boston" "USA"))
(define rms
(person 30 "rms@@gnu.org" fsf-address))
(and (equal? (set-person-age rms 60)
(person 60 "rms@@gnu.org" fsf-address))
(= (person-age rms) 30))
@result{} #t
@end example
@noindent
Here, the original @code{<person>} record, to which @var{rms} is bound,
is left unchanged.
Now, suppose we want to change both the street and age of @var{rms}.
This can be achieved using @code{set-fields}:
@example
(set-fields rms
((person-age) 60)
((person-address address-street) "Temple Place"))
@result{} #<<person> age: 60 email: "rms@@gnu.org"
address: #<<address> street: "Temple Place" city: "Boston" country: "USA">>
@end example
@noindent
Notice how the above changed two fields of @var{rms}, including the
@code{street} field of its @code{address} field, in a concise way. Also
note that @code{set-fields} works equally well for types defined with
just @code{define-record-type}.
@node Records
@subsection Records

104
doc/ref/srfi-modules.texi
View file

@ -1862,110 +1862,12 @@ procedures easier. It is documented in @xref{Multiple Values}.
@node SRFI-9
@subsection SRFI-9 - define-record-type
@cindex SRFI-9
@cindex record
This SRFI is a syntax for defining new record types and creating
predicate, constructor, and field getter and setter functions. In
Guile this is simply an alternate interface to the core record
functionality (@pxref{Records}). It can be used with,
predicate, constructor, and field getter and setter functions. It is
documented in the ``Compound Data Types'' section of the manual
(@pxref{SRFI-9 Records}).
@example
(use-modules (srfi srfi-9))
@end example
@deffn {library syntax} define-record-type type @* (constructor fieldname @dots{}) @* predicate @* (fieldname accessor [modifier]) @dots{}
@sp 1
Create a new record type, and make various @code{define}s for using
it. This syntax can only occur at the top-level, not nested within
some other form.
@var{type} is bound to the record type, which is as per the return
from the core @code{make-record-type}. @var{type} also provides the
name for the record, as per @code{record-type-name}.
@var{constructor} is bound to a function to be called as
@code{(@var{constructor} fieldval @dots{})} to create a new record of
this type. The arguments are initial values for the fields, one
argument for each field, in the order they appear in the
@code{define-record-type} form.
The @var{fieldname}s provide the names for the record fields, as per
the core @code{record-type-fields} etc, and are referred to in the
subsequent accessor/modifier forms.
@var{predicate} is bound to a function to be called as
@code{(@var{predicate} obj)}. It returns @code{#t} or @code{#f}
according to whether @var{obj} is a record of this type.
Each @var{accessor} is bound to a function to be called
@code{(@var{accessor} record)} to retrieve the respective field from a
@var{record}. Similarly each @var{modifier} is bound to a function to
be called @code{(@var{modifier} record val)} to set the respective
field in a @var{record}.
@end deffn
@noindent
An example will illustrate typical usage,
@example
(define-record-type employee-type
(make-employee name age salary)
employee?
(name get-employee-name)
(age get-employee-age set-employee-age)
(salary get-employee-salary set-employee-salary))
@end example
This creates a new employee data type, with name, age and salary
fields. Accessor functions are created for each field, but no
modifier function for the name (the intention in this example being
that it's established only when an employee object is created). These
can all then be used as for example,
@example
employee-type @result{} #<record-type employee-type>
(define fred (make-employee "Fred" 45 20000.00))
(employee? fred) @result{} #t
(get-employee-age fred) @result{} 45
(set-employee-salary fred 25000.00) ;; pay rise
@end example
The functions created by @code{define-record-type} are ordinary
top-level @code{define}s. They can be redefined or @code{set!} as
desired, exported from a module, etc.
@unnumberedsubsubsec Non-toplevel Record Definitions
The SRFI-9 specification explicitly disallows record definitions in a
non-toplevel context, such as inside @code{lambda} body or inside a
@var{let} block. However, Guile's implementation does not enforce that
restriction.
@unnumberedsubsubsec Custom Printers
You may use @code{set-record-type-printer!} to customize the default printing
behavior of records. This is a Guile extension and is not part of SRFI-9. It
is located in the @nicode{(srfi srfi-9 gnu)} module.
@deffn {Scheme Syntax} set-record-type-printer! name thunk
Where @var{type} corresponds to the first argument of @code{define-record-type},
and @var{thunk} is a procedure accepting two arguments, the record to print, and
an output port.
@end deffn
@noindent
This example prints the employee's name in brackets, for instance @code{[Fred]}.
@example
(set-record-type-printer! employee-type
(lambda (record port)
(write-char #\[ port)
(display (get-employee-name record) port)
(write-char #\] port)))
@end example
@node SRFI-10
@subsection SRFI-10 - Hash-Comma Reader Extension

3
module/Makefile.am
View file

@ -187,7 +187,8 @@ SYSTEM_BASE_SOURCES = \
system/base/language.scm \
system/base/lalr.scm \
system/base/message.scm \
system/base/target.scm
system/base/target.scm \
system/base/ck.scm
ICE_9_SOURCES = \
ice-9/r5rs.scm \

16
module/ice-9/futures.scm
View file

@ -19,6 +19,7 @@
(define-module (ice-9 futures)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (ice-9 threads)
#:use-module (ice-9 q)
#:export (future make-future future? touch))
@ -157,15 +158,20 @@ touched."
(define %workers '())
(define (%create-workers!)
(lock-mutex %futures-mutex)
(with-mutex
%futures-mutex
;; Setting 'create-workers!' to a no-op is an optimization, but it is
;; still possible for '%create-workers!' to be called more than once
;; from different threads. Therefore, to avoid creating %workers more
;; than once (and thus creating too many threads), we check to make
;; sure %workers is empty within the critical section.
(when (null? %workers)
(set! %workers
(unfold (lambda (i) (>= i %worker-count))
(lambda (i)
(call-with-new-thread process-futures))
(lambda (i) (call-with-new-thread process-futures))
1+
0))
(set! create-workers! (lambda () #t))
(unlock-mutex %futures-mutex))
(set! create-workers! (lambda () #t)))))
(define create-workers!
(lambda () (%create-workers!)))

21
module/srfi/srfi-9.scm
View file

@ -60,6 +60,7 @@
(define-module (srfi srfi-9)
#:use-module (srfi srfi-1)
#:use-module (system base ck)
#:export (define-record-type))
(cond-expand-provide (current-module) '(srfi-9))
@ -81,16 +82,22 @@
(define-syntax-rule (%%on-error err) err)
(define %%type #f) ; a private syntax literal
(define-syntax-rule (getter-type getter err)
(getter (%%on-error err) %%type))
(define-syntax getter-type
(syntax-rules (quote)
((_ s 'getter 'err)
(getter (%%on-error err) %%type s))))
(define %%index #f) ; a private syntax literal
(define-syntax-rule (getter-index getter err)
(getter (%%on-error err) %%index))
(define-syntax getter-index
(syntax-rules (quote)
((_ s 'getter 'err)
(getter (%%on-error err) %%index s))))
(define %%copier #f) ; a private syntax literal
(define-syntax-rule (getter-copier getter err)
(getter (%%on-error err) %%copier))
(define-syntax getter-copier
(syntax-rules (quote)
((_ s 'getter 'err)
(getter (%%on-error err) %%copier s))))
(define-syntax define-tagged-inlinable
(lambda (x)
@ -110,7 +117,7 @@
(define-syntax name
(lambda (x)
(syntax-case x (%%on-error key ...)
((_ (%%on-error err) key) #'value) ...
((_ (%%on-error err) key s) #'(ck s 'value)) ...
((_ args ...)
#'((lambda (formals ...)
body ...)

62
module/srfi/srfi-9/gnu.scm
View file

@ -24,6 +24,7 @@
(define-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-1)
#:use-module (system base ck)
#:export (set-record-type-printer!
define-immutable-record-type
set-field
@ -38,8 +39,8 @@
#t (define-immutable-record-type name ctor pred fields ...)
name ctor pred fields ...))
(define-syntax-rule (set-field (getter ...) s expr)
(%set-fields #t (set-field (getter ...) s expr) ()
(define-syntax-rule (set-field s (getter ...) expr)
(%set-fields #t (set-field s (getter ...) expr) ()
s ((getter ...) expr)))
(define-syntax-rule (set-fields s . rest)
@ -76,12 +77,41 @@
(with-syntax (((((head . tail) expr) ...) specs))
(fold insert '() #'(head ...) #'(tail ...) #'(expr ...))))
(define-syntax %set-fields-unknown-getter
(define-syntax unknown-getter
(lambda (x)
(syntax-case x ()
((_ orig-form getter)
(syntax-violation 'set-fields "unknown getter" #'orig-form #'getter)))))
(define-syntax c-list
(lambda (x)
(syntax-case x (quote)
((_ s 'v ...)
#'(ck s '(v ...))))))
(define-syntax c-same-type-check
(lambda (x)
(syntax-case x (quote)
((_ s 'orig-form '(path ...)
'(getter0 getter ...)
'(type0 type ...)
'on-success)
(every (lambda (t g)
(or (free-identifier=? t #'type0)
(syntax-violation
'set-fields
(format #f
"\
field paths ~a and ~a require one object to belong to two different record types (~a and ~a)"
(syntax->datum #`(path ... #,g))
(syntax->datum #'(path ... getter0))
(syntax->datum t)
(syntax->datum #'type0))
#'orig-form)))
#'(type ...)
#'(getter ...))
#'(ck s 'on-success)))))
(define-syntax %set-fields
(lambda (x)
(with-syntax ((getter-type #'(@@ (srfi srfi-9) getter-type))
@ -98,24 +128,34 @@
struct-expr ((head . tail) expr) ...)
(let ((collated-specs (collate-set-field-specs
#'(((head . tail) expr) ...))))
(with-syntax ((getter (caar collated-specs)))
(with-syntax ((err #'(%set-fields-unknown-getter
orig-form getter)))
#`(let ((s struct-expr))
((getter-copier getter err)
(with-syntax (((getter0 getter ...)
(map car collated-specs)))
(with-syntax ((err #'(unknown-getter
orig-form getter0)))
#`(ck
()
(c-same-type-check
'orig-form
'(path-so-far ...)
'(getter0 getter ...)
(c-list (getter-type 'getter0 'err)
(getter-type 'getter 'err) ...)
'(let ((s struct-expr))
((ck () (getter-copier 'getter0 'err))
check?
s
#,@(map (lambda (spec)
(with-syntax (((head (tail expr) ...) spec))
(with-syntax ((err #'(%set-fields-unknown-getter
(with-syntax ((err #'(unknown-getter
orig-form head)))
#'(head (%set-fields
check?
orig-form
(path-so-far ... head)
(struct-ref s (getter-index head err))
(struct-ref s (ck () (getter-index
'head 'err)))
(tail expr) ...)))))
collated-specs)))))))
collated-specs)))))))))
((_ check? orig-form (path-so-far ...)
s (() e) (() e*) ...)
(syntax-violation 'set-fields "duplicate field path"

55
module/system/base/ck.scm Normal file
View file

@ -0,0 +1,55 @@
;;; ck, to facilitate applicative-order macro programming
;;; Copyright (C) 2012 Free Software Foundation, Inc
;;; Copyright (C) 2009, 2011 Oleg Kiselyov
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;
;;;
;;; Originally written by Oleg Kiselyov and later contributed to Guile.
;;;
;;; Based on the CK machine introduced in:
;;;
;;; Matthias Felleisen and Daniel P. Friedman: Control operators, the
;;; SECD machine, and the lambda-calculus. In Martin Wirsing, editor,
;;; Formal Description of Programming Concepts III, pages
;;; 193-217. Elsevier, Amsterdam, 1986.
;;;
;;; See http://okmij.org/ftp/Scheme/macros.html#ck-macros for details.
;;;
(define-module (system base ck)
#:export (ck))
(define-syntax ck
(syntax-rules (quote)
((ck () 'v) v) ; yield the value on empty stack
((ck (((op ...) ea ...) . s) 'v) ; re-focus on the other argument, ea
(ck-arg s (op ... 'v) ea ...))
((ck s (op ea ...)) ; Focus: handling an application;
(ck-arg s (op) ea ...)))) ; check if args are values
(define-syntax ck-arg
(syntax-rules (quote)
((ck-arg s (op va ...)) ; all arguments are evaluated,
(op s va ...)) ; do the redex
((ck-arg s (op ...) 'v ea1 ...) ; optimization when the first ea
(ck-arg s (op ... 'v) ea1 ...)) ; was already a value
((ck-arg s (op ...) ea ea1 ...) ; focus on ea, to evaluate it
(ck (((op ...) ea1 ...) . s) ea))))

70
test-suite/tests/srfi-9.test
View file

@ -103,9 +103,9 @@
(pass-if "set-field"
(let ((s (make-foo (make-bar 1 2))))
(and (equal? (set-field (foo-x bar-j) s 3)
(and (equal? (set-field s (foo-x bar-j) 3)
(make-foo (make-bar 1 3)))
(equal? (set-field (foo-z) s 'bar)
(equal? (set-field s (foo-z) 'bar)
(let ((s2 (make-foo (make-bar 1 2))))
(set-foo-z! s2 'bar)
s2))
@ -113,19 +113,19 @@
(pass-if-exception "set-field on wrong struct type" exception:wrong-type-arg
(let ((s (make-bar (make-foo 5) 2)))
(set-field (foo-x bar-j) s 3)))
(set-field s (foo-x bar-j) 3)))
(pass-if-exception "set-field on number" exception:wrong-type-arg
(set-field (foo-x bar-j) 4 3))
(set-field 4 (foo-x bar-j) 3))
(pass-if-equal "set-field with unknown first getter"
'(syntax-error set-fields "unknown getter"
(set-field (blah) s 3)
(set-field s (blah) 3)
blah)
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
(set-field (blah) s 3))
(set-field s (blah) 3))
#:env (current-module))
#f)
(lambda (key whom what src form subform)
@ -133,12 +133,12 @@
(pass-if-equal "set-field with unknown second getter"
'(syntax-error set-fields "unknown getter"
(set-field (bar-j blah) s 3)
(set-field s (bar-j blah) 3)
blah)
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
(set-field (bar-j blah) s 3))
(set-field s (bar-j blah) 3))
#:env (current-module))
#f)
(lambda (key whom what src form subform)
@ -146,7 +146,7 @@
(pass-if "set-fields"
(let ((s (make-foo (make-bar 1 2))))
(and (equal? (set-field (foo-x bar-j) s 3)
(and (equal? (set-field s (foo-x bar-j) 3)
(make-foo (make-bar 1 3)))
(equal? (set-fields s
((foo-x bar-j) 3)
@ -262,18 +262,18 @@
(pass-if "set-field"
(let ((s (make-foo (make-bar 1 2))))
(and (equal? (set-field (foo-x bar-j) s 3)
(and (equal? (set-field s (foo-x bar-j) 3)
(make-foo (make-bar 1 3)))
(equal? (set-field (foo-z) s 'bar)
(equal? (set-field s (foo-z) 'bar)
(let ((s2 (make-foo (make-bar 1 2))))
(set-foo-z! s2 'bar)
s2))
(equal? s (make-foo (make-bar 1 2)))))))
(pass-if "set-fields"
(pass-if "set-fieldss "
(let ((s (make-foo (make-bar 1 2))))
(and (equal? (set-field (foo-x bar-j) s 3)
(and (equal? (set-field s (foo-x bar-j) 3)
(make-foo (make-bar 1 3)))
(equal? (set-fields s
((foo-x bar-j) 3)
@ -340,10 +340,10 @@
(pass-if "set-field"
(let ((p (make-person 30 "foo@example.com"
(make-address "Foo" "Paris" "France"))))
(and (equal? (set-field (person-address address-street) p "Bar")
(and (equal? (set-field p (person-address address-street) "Bar")
(make-person 30 "foo@example.com"
(make-address "Bar" "Paris" "France")))
(equal? (set-field (person-email) p "bar@example.com")
(equal? (set-field p (person-email) "bar@example.com")
(make-person 30 "bar@example.com"
(make-address "Foo" "Paris" "France")))
(equal? p (make-person 30 "foo@example.com"
@ -448,10 +448,10 @@
(let ((p (make-person 30 "foo@example.com"
(make-address "Foo" "Paris" "France"))))
(and (equal? (set-field (person-address address-street) p "Bar")
(and (equal? (set-field p (person-address address-street) "Bar")
(make-person 30 "foo@example.com"
(make-address "Bar" "Paris" "France")))
(equal? (set-field (person-email) p "bar@example.com")
(equal? (set-field p (person-email) "bar@example.com")
(make-person 30 "bar@example.com"
(make-address "Foo" "Paris" "France")))
(equal? p (make-person 30 "foo@example.com"
@ -607,6 +607,42 @@
((bar-i) 3))))
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(list key whom what form subform))))
(pass-if-equal "incompatible field paths"
'(syntax-error set-fields
"\
field paths (bar-i bar-j) and (bar-i foo-x) require one object \
to belong to two different record types (bar and foo)"
(set-fields s
((bar-i foo-x) 1)
((bar-i bar-j) 2)
((bar-j) 3))
#f)
(catch 'syntax-error
(lambda ()
(compile '(let ()
(define-immutable-record-type foo
(make-foo x)
foo?
(x foo-x)
(y foo-y set-foo-y)
(z foo-z set-foo-z))
(define-immutable-record-type bar
(make-bar i j)
bar?
(i bar-i)
(j bar-j set-bar-j))
(let ((s (make-bar (make-foo 5) 2)))
(set-fields s
((bar-i foo-x) 1)
((bar-i bar-j) 2)
((bar-j) 3))))
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(list key whom what form subform))))))