commit 427ef7829eb6a1e46f099820e6d149108e71baca
parent 9af1e49fb2f797f2963588d89e4ca7923f8320fd
Author: Arthur A. Gleckler <srfi@speechcode.com>
Date: Sat, 5 Sep 2015 13:06:47 -0700
Merge pull request #7 from TaylanUB/master
Changes from Taylan for draft #7:
Don't discriminate unsafe Scheme implementations. a660fdb
@TaylanUB Remove a redundant comma in the prose. 8346947
@TaylanUB Call the implementation "sample" not "reference". eae6a71
@TaylanUB Support record inspection. 79f9060
@TaylanUB Code only: minor cleanup. de58af9
@TaylanUB Code only: add s16vector stub in test suite. … c14c331
@TaylanUB Code only: don't use expression cond-expand. … e486f2f
@TaylanUB Code only: expect test failure on SRFI-99.
Ready for new draft.
Diffstat:
5 files changed, 179 insertions(+), 85 deletions(-)
diff --git a/srfi-123.html b/srfi-123.html
@@ -44,7 +44,7 @@ struct ;=> #(a (x y #u8(4 2 3)) c)</code></pre>
(ref table "foo" 'not-found) ;=> not-found
(set! (~ table "foo") "Foobar.")
(ref table "foo" 'not-found) ;=> "Foobar."</code></pre>
-<p>Lack of a default argument raises an error in this case. Since <code>ref*</code> cannot take default arguments for any fields it accesses, it always raises an error when a hashtable key in the chain is not found.</p>
+<p>Lack of a default argument is an error in this case. Since <code>ref*</code> cannot take default arguments for any fields it accesses, it is an error when a hashtable key in the chain is not found.</p>
<pre><code>(define table (make-eqv-hashtable))
(define lst (list 0 1 table 3))
(ref* lst 2 "foo" 'x) ;error while accessing "foo" from table</code></pre>
@@ -74,7 +74,7 @@ struct ;=> #(a (x y #u8(4 2 3)) c)</code></pre>
</ul>
<p>Alists are difficult to support due to the lack of a reliable <code>alist?</code> predicate. (It's ambiguous in that every alist is also a list, and any list may coincidentally have the structure of an alist.) It was considered to support non-integer keyed alists as a special case, but this would lead to silent code breakage when a programmer forgot about the API inconsistency and exchanged a non-integer key for an integer key in existing code. It was also considered to drop list support in favor of alist support, but that idea discarded as well because the hypothetical <code>alist-set!</code> is an exceedingly rare operation. (Prepending an entry to the front, possibly hiding another entry with the same key, is more common.)</p>
<h2 id="integration-with-srfi-105">Integration with SRFI-105</h2>
-<p>The <code>ref*</code> procedure is a good candidate for SRFI-105's <code>$bracket-apply$</code>. Indeed the reference implementation exports <code>$bracket-apply$</code> as a synonym to <code>ref*</code>. In code that already uses SRFI-105 heavily, a programmer may additionally define <code>:=</code> as a synonym to <code>set!</code>, and then use the following syntax: <code>{object[field] := value}</code>.</p>
+<p>The <code>ref*</code> procedure is a good candidate for SRFI-105's <code>$bracket-apply$</code>. Indeed the sample implementation exports <code>$bracket-apply$</code> as a synonym to <code>ref*</code>. In code that already uses SRFI-105 heavily, a programmer may additionally define <code>:=</code> as a synonym to <code>set!</code>, and then use the following syntax: <code>{object[field] := value}</code>.</p>
<pre><code>#!curly-infix
(import (rename (only (scheme base) set!) (set! :=)))
(define vec (vector 0 1 2 3))
@@ -83,19 +83,18 @@ struct ;=> #(a (x y #u8(4 2 3)) c)</code></pre>
{vec[1] + vec[2]} ;=> 5</code></pre>
<p>The square brackets accept a chain of fields, since they have the semantics of <code>ref*</code>: <code>{matrix[i j]}</code>.</p>
<h2 id="specification">Specification</h2>
+<p>Within this section, whenever a situation is described as being an error, a Scheme implementation supporting error signaling should signal an error.</p>
<ul>
<li><code>(ref object field)</code> (procedure)</li>
<li><code>(ref object field default)</code></li>
</ul>
-<p>Returns the value for <code>field</code> in <code>object</code>. An error is raised if <code>object</code> has no field identified by <code>field</code>. (This error will often come from the underlying accessor procedure.)</p>
+<p>Returns the value for <code>field</code> in <code>object</code>. It is an error if <code>object</code> has no field identified by <code>field</code>.</p>
<pre><code>(ref #(0 1 2) 3) ;error: vector-ref: Index out of bounds.</code></pre>
-<p>If <code>object</code> is of a "sparse" type, meaning its fields can be "empty" or "unassigned" (e.g. a hashtable), and the requested field is empty, then the value of <code>default</code> is returned if given, and otherwise an error raised.</p>
+<p>If <code>object</code> is of a "sparse" type, meaning its fields can be "empty" or "unassigned" (e.g. a hashtable), and the requested field is empty, then the value of <code>default</code> is returned. It is an error if the <code>default</code> argument is not provided in this case.</p>
<pre><code>(ref hashtable unassigned-key 'default) ;=> default
(ref hashtable unassigned-key) ;error</code></pre>
-<p>If <code>object</code> is not of a sparse type, then passing <code>default</code> is an error.</p>
-<pre><code>(ref '(0 1 2) 3 'default) ;error: list-ref: Too many arguments.
- ;Unless the implementation's list-ref
- ;does something else.</code></pre>
+<p>If <code>object</code> is not of a sparse type, then providing the <code>default</code> argument is an error.</p>
+<pre><code>(ref '(0 1 2) 3 'default) ;error: list-ref: Too many arguments.</code></pre>
<p>Valid types for <code>object</code> are: bytevectors, hashtables, pairs, strings, vectors, non-opaque record types, and SRFI-4 vectors if present. Only hashtables are a sparse type. Implementations are encouraged to expand this list of types with any further types they support.</p>
<p>Valid types for <code>field</code> depend on the type of <code>object</code>. For bytevectors, hashtables, strings, vectors, and SRFI-4 vectors, refer to their respective <code>*-ref</code> procedures. For pairs, refer to <code>list-ref</code>. For records, symbols that correspond with the record type's field names are allowed.</p>
<p>A conforming implementation must be prepared for SRFI-4 vector types and bytevectors not being disjoint types, and treat SRFI-4 vectors suitably and not as regular bytevectors.</p>
@@ -120,14 +119,15 @@ vec ;=> #(3 1 2)</code></pre>
</ul>
<p>Registers a new type/getter/setter triple for the dynamic dispatch. <code>Type</code> is a type predicate, <code>getter</code> is a procedure that has a setter associated with it, and <code>sparse?</code> is a Boolean indicating whether the type is a sparse type (see <code>ref</code> specification).</p>
<p>The getter will be called with two arguments: the object whose field should be accessed, and an object identifying the field to be accessed. The setter will be called with one additional argument which is the value to be assigned to the given field of the given object.</p>
-<p><strong>Warning:</strong> This procedure is strictly meant for when defining a new disjoint type, which isn't already handled by <code>ref</code>. In practice, this means it should only be used with newly defined opaque record types, or types defined with some implementation-specific method which, unlike <code>define-record-type</code>, doesn't automatically register a getter and setter for the type. If any two type predicates registered with the system both return true for any Scheme object, the behavior is undefined. (A custom getter or setter may, however, dispatch to different actions based on some property of the given object, based on the <code>field</code> argument, or based on anything else.)</p>
+<p><strong>Warning:</strong> This procedure is strictly meant for when defining a new disjoint type which isn't already handled by <code>ref</code>. In practice, this means it should only be used with newly defined opaque record types, or types defined with some implementation-specific method which, unlike <code>define-record-type</code>, doesn't automatically register a getter and setter for the type. If any two type predicates registered with the system both return true for any Scheme object, the behavior is undefined. (A custom getter or setter may, however, dispatch to different actions based on some property of the given object, based on the <code>field</code> argument, or based on anything else.)</p>
<p>It is conceivable that this method will become deprecated after a system has been invented which ties together the definition of a new opaque record type with the definitions of its getter and setter. This is considered outside the scope of this SRFI.</p>
<h2 id="considerations-when-using-as-a-library">Considerations when using as a library</h2>
-<p>The intent of this SRFI is to encourage Scheme systems to extend their standard library in accordance with the above specification. On the meanwhile, the reference implementation can be used as a separate library, but certain considerations apply.</p>
+<p>The intent of this SRFI is to encourage Scheme systems to extend their standard library in accordance with the above specification. On the meanwhile, the sample implementation can be used as a separate library, but certain considerations apply.</p>
<p>The <code>define-record-type</code> export of the library conflicts with the one in <code>(scheme base)</code>, so either has to be renamed, or more typically, the one from <code>(scheme base)</code> excluded.</p>
<p>Record types not defined with the <code>define-record-type</code> exported by this library won't work with <code>ref</code>, <code>ref*</code>, or their setters.</p>
+<p>This problem does not apply to implementations supporting inspection of records and record types.</p>
<h2 id="implementation">Implementation</h2>
-<p>A reference implementation as a library is found in the version control repository of this SRFI.</p>
+<p>A sample implementation as a library is found in the version control repository of this SRFI.</p>
<p>It might be desirable for Scheme systems to offer a more efficient <code>type-of</code> procedure than the one used in this implementation, which in the worst case consumes linear time with regard to the number of types (including every record type) within the system, albeit with a very small constant factor: one call to each type predicate.</p>
<h2 id="acknowledgments">Acknowledgments</h2>
<p>Thanks to Jorgen Schäfer for inspiring me to write this SRFI and making the initial suggestion for the <code>ref</code> procedure and ternary <code>set!</code> syntax, as well as providing continuous input.</p>
diff --git a/srfi-123.md b/srfi-123.md
@@ -76,9 +76,9 @@ argument for objects such as hashtables.
(set! (~ table "foo") "Foobar.")
(ref table "foo" 'not-found) ;=> "Foobar."
-Lack of a default argument raises an error in this case. Since `ref*`
-cannot take default arguments for any fields it accesses, it always
-raises an error when a hashtable key in the chain is not found.
+Lack of a default argument is an error in this case. Since `ref*`
+cannot take default arguments for any fields it accesses, it is an
+error when a hashtable key in the chain is not found.
(define table (make-eqv-hashtable))
(define lst (list 0 1 table 3))
@@ -160,7 +160,7 @@ Integration with SRFI-105
-------------------------
The `ref*` procedure is a good candidate for SRFI-105's
-`$bracket-apply$`. Indeed the reference implementation exports
+`$bracket-apply$`. Indeed the sample implementation exports
`$bracket-apply$` as a synonym to `ref*`. In code that already uses
SRFI-105 heavily, a programmer may additionally define `:=` as a
synonym to `set!`, and then use the following syntax:
@@ -180,29 +180,30 @@ semantics of `ref*`: `{matrix[i j]}`.
Specification
-------------
+Within this section, whenever a situation is described as being an
+error, a Scheme implementation supporting error signaling should
+signal an error.
+
- `(ref object field)` (procedure)
- `(ref object field default)`
-Returns the value for `field` in `object`. An error is raised if
-`object` has no field identified by `field`. (This error will often
-come from the underlying accessor procedure.)
+Returns the value for `field` in `object`. It is an error if `object`
+has no field identified by `field`.
(ref #(0 1 2) 3) ;error: vector-ref: Index out of bounds.
If `object` is of a "sparse" type, meaning its fields can be "empty"
or "unassigned" (e.g. a hashtable), and the requested field is empty,
-then the value of `default` is returned if given, and otherwise an
-error raised.
+then the value of `default` is returned. It is an error if the
+`default` argument is not provided in this case.
(ref hashtable unassigned-key 'default) ;=> default
(ref hashtable unassigned-key) ;error
-If `object` is not of a sparse type, then passing `default` is an
-error.
+If `object` is not of a sparse type, then providing the `default`
+argument is an error.
(ref '(0 1 2) 3 'default) ;error: list-ref: Too many arguments.
- ;Unless the implementation's list-ref
- ;does something else.
Valid types for `object` are: bytevectors, hashtables, pairs, strings,
vectors, non-opaque record types, and SRFI-4 vectors if present. Only
@@ -259,13 +260,13 @@ which is the value to be assigned to the given field of the given
object.
**Warning:** This procedure is strictly meant for when defining a new
-disjoint type, which isn't already handled by `ref`. In practice,
-this means it should only be used with newly defined opaque record
-types, or types defined with some implementation-specific method
-which, unlike `define-record-type`, doesn't automatically register a
-getter and setter for the type. If any two type predicates registered
-with the system both return true for any Scheme object, the behavior
-is undefined. (A custom getter or setter may, however, dispatch to
+disjoint type which isn't already handled by `ref`. In practice, this
+means it should only be used with newly defined opaque record types,
+or types defined with some implementation-specific method which,
+unlike `define-record-type`, doesn't automatically register a getter
+and setter for the type. If any two type predicates registered with
+the system both return true for any Scheme object, the behavior is
+undefined. (A custom getter or setter may, however, dispatch to
different actions based on some property of the given object, based on
the `field` argument, or based on anything else.)
@@ -280,7 +281,7 @@ Considerations when using as a library
The intent of this SRFI is to encourage Scheme systems to extend their
standard library in accordance with the above specification. On the
-meanwhile, the reference implementation can be used as a separate
+meanwhile, the sample implementation can be used as a separate
library, but certain considerations apply.
The `define-record-type` export of the library conflicts with the one
@@ -290,12 +291,15 @@ the one from `(scheme base)` excluded.
Record types not defined with the `define-record-type` exported by
this library won't work with `ref`, `ref*`, or their setters.
+This problem does not apply to implementations supporting inspection
+of records and record types.
+
Implementation
--------------
-A reference implementation as a library is found in the version
-control repository of this SRFI.
+A sample implementation as a library is found in the version control
+repository of this SRFI.
It might be desirable for Scheme systems to offer a more efficient
`type-of` procedure than the one used in this implementation, which in
diff --git a/srfi/123.body.scm b/srfi/123.body.scm
@@ -53,6 +53,36 @@
(else
(list-set! pair key value))))
+;;; Record inspection support
+
+(cond-expand
+ ((or (library (srfi 99))
+ (library (rnrs records inspection))
+ (library (r6rs records inspection)))
+ (cond-expand
+ ((not (library (srfi 99)))
+ (define rtd-accessor record-accessor)
+ (define rtd-mutator record-mutator))
+ (else))
+ (define (record-ref record field)
+ (let* ((rtd (record-rtd record))
+ (accessor (rtd-accessor rtd field)))
+ (accessor record)))
+ (define (record-set! record field value)
+ (let* ((rtd (record-rtd record))
+ (mutator (rtd-mutator rtd field)))
+ (mutator record value)))
+ (define record-getters
+ (list (cons record? record-ref)))
+ (define record-setters
+ (list (cons record? record-set!)))
+ (define record-types
+ (list record?)))
+ (else
+ (define record-getters '())
+ (define record-setters '())
+ (define record-types '())))
+
;;; SRFI-4 support
;;; In some implementations, SRFI-4 vectors are also bytevectors. We accomodate
@@ -87,11 +117,15 @@
(define srfi-4-setters-table (alist->hashtable srfi-4-setters))
(define (bytevector-ref bytevector index)
(let* ((type (find (lambda (pred) (pred bytevector))) srfi-4-types)
- (getter (ref srfi-4-getters-table type bytevector-u8-ref)))
+ (getter (if type
+ (ref srfi-4-getters-table type)
+ bytevector-u8-ref)))
(getter bytevector index)))
(define (bytevector-set! bytevector index value)
(let* ((type (find (lambda (pred) (pred bytevector))) srfi-4-types)
- (setter (ref srfi-4-setters-table type bytevector-u8-set!)))
+ (setter (if type
+ (ref srfi-4-setters-table type)
+ bytevector-u8-set!)))
(setter bytevector index value))))
(else
(define srfi-4-getters '())
@@ -167,6 +201,7 @@
(cons pair? pair-ref)
(cons string? string-ref)
(cons vector? vector-ref))
+ record-getters
srfi-4-getters)))
(define setter-table
@@ -177,6 +212,7 @@
(cons pair? pair-set!)
(cons string? string-set!)
(cons vector? vector-set!))
+ record-setters
srfi-4-setters)))
(define sparse-types
@@ -186,6 +222,7 @@
(append
(list boolean? bytevector? char? eof-object? hashtable? null? number? pair?
port? procedure? string? symbol? vector?)
+ record-types
srfi-4-types))
(define (register-getter-with-setter! type getter sparse?)
@@ -195,48 +232,53 @@
(when sparse?
(push! sparse-types type)))
-(define-syntax define-record-type
- (syntax-rules ()
- ((_ <name> <constructor> <pred> <field> ...)
- (begin
- (%define-record-type <name> <constructor> <pred> <field> ...)
- ;; Throw-away definition to not disturb an internal definitions sequence.
- (define __throwaway
- (begin
- (register-getter-with-setter!
- <pred>
- (getter-with-setter (record-getter <field> ...)
- (record-setter <field> ...))
- #f)
- ;; Return the implementation's preferred "unspecified" value.
- (if #f #f)))))))
-
-(define-syntax record-getter
- (syntax-rules ()
- ((_ (<field> <getter> . <rest>) ...)
- (let ((getters (alist->hashtable (list (cons '<field> <getter>) ...))))
- (lambda (record field)
- (let ((getter (or (ref getters field #f)
- (error "No such field of record." record field))))
- (getter record)))))))
-
-(define-syntax record-setter
- (syntax-rules ()
- ((_ . <rest>)
- (%record-setter () . <rest>))))
-
-(define-syntax %record-setter
- (syntax-rules ()
- ((_ <setters> (<field> <getter>) . <rest>)
- (%record-setter <setters> . <rest>))
- ((_ <setters> (<field> <getter> <setter>) . <rest>)
- (%record-setter ((<field> <setter>) . <setters>) . <rest>))
- ((_ ((<field> <setter>) ...))
- (let ((setters (alist->hashtable (list (cons '<field> <setter>) ...))))
- (lambda (record field value)
- (let ((setter (or (ref setters field #f)
- (error "No such assignable field of record."
- record field))))
- (setter record value)))))))
+(cond-expand
+ ((not (or (library (srfi 99))
+ (library (rnrs records inspection))
+ (library (r6rs records inspection))))
+ (define-syntax define-record-type
+ (syntax-rules ()
+ ((_ <name> <constructor> <pred> <field> ...)
+ (begin
+ (%define-record-type <name> <constructor> <pred> <field> ...)
+ ;; Throw-away definition to not disturb an internal definitions
+ ;; sequence.
+ (define __throwaway
+ (begin
+ (register-getter-with-setter!
+ <pred>
+ (getter-with-setter (record-getter <field> ...)
+ (record-setter <field> ...))
+ #f)
+ ;; Return the implementation's preferred "unspecified" value.
+ (if #f #f)))))))
+
+ (define-syntax record-getter
+ (syntax-rules ()
+ ((_ (<field> <getter> . <rest>) ...)
+ (let ((getters (alist->hashtable (list (cons '<field> <getter>) ...))))
+ (lambda (record field)
+ (let ((getter (or (ref getters field #f)
+ (error "No such field of record." record field))))
+ (getter record)))))))
+
+ (define-syntax record-setter
+ (syntax-rules ()
+ ((_ . <rest>)
+ (%record-setter () . <rest>))))
+
+ (define-syntax %record-setter
+ (syntax-rules ()
+ ((_ <setters> (<field> <getter>) . <rest>)
+ (%record-setter <setters> . <rest>))
+ ((_ <setters> (<field> <getter> <setter>) . <rest>)
+ (%record-setter ((<field> <setter>) . <setters>) . <rest>))
+ ((_ ((<field> <setter>) ...))
+ (let ((setters (alist->hashtable (list (cons '<field> <setter>) ...))))
+ (lambda (record field value)
+ (let ((setter (or (ref setters field #f)
+ (error "No such assignable field of record."
+ record field))))
+ (setter record value)))))))))
;;; generic-ref-set.body.scm ends here
diff --git a/srfi/123.sld b/srfi/123.sld
@@ -2,17 +2,33 @@
(export
ref ref* ~ register-getter-with-setter!
$bracket-apply$
- define-record-type
set! setter getter-with-setter)
(import
- (rename (except (scheme base) set!)
- (define-record-type %define-record-type))
+ (except (scheme base) set! define-record-type)
(scheme case-lambda)
(r6rs hashtables)
(srfi 1)
(srfi 17)
(srfi 31))
(cond-expand
+ ;; Favor SRFI-99.
+ ((library (srfi 99))
+ (import (srfi 99)))
+ ;; We assume that if there's the inspection library, there's also the
+ ;; syntactic and procedural libraries.
+ ((library (rnrs records inspection))
+ (import (rnrs records syntactic))
+ (import (rnrs records procedural))
+ (import (rnrs records inspection)))
+ ((library (r6rs records inspection))
+ (import (r6rs records syntactic))
+ (import (r6rs records procedural))
+ (import (r6rs records inspection)))
+ (else
+ (import (rename (only (scheme base) define-record-type)
+ (define-record-type %define-record-type)))
+ (export define-record-type)))
+ (cond-expand
((library (srfi 4))
(import (srfi 4)))
(else))
diff --git a/tests/srfi-123.sld b/tests/srfi-123.sld
@@ -28,15 +28,41 @@
(srfi 64)
(srfi 123))
(cond-expand
+ ((library (srfi 99))
+ (import (srfi 99)))
+ ((library (rnrs records inspection))
+ (import (rnrs records syntactic))
+ (import (rnrs records procedural)))
+ (import (rnrs records inspection))
+ ((library (r6rs records inspection))
+ (import (r6rs records syntactic))
+ (import (r6rs records procedural)))
+ (import (r6rs records inspection))
+ (else))
+ (cond-expand
((library (srfi 4))
(import (srfi 4)))
- (else))
+ (else
+ (begin
+ ;; Stub to silence compilers.
+ (define s16vector #f))))
(begin
(define-record-type <foo> (make-foo a b) foo?
(a foo-a set-foo-a!)
(b foo-b))
+ ;; The SRFI-99 sample implementation contains a bug where immutable fields
+ ;; are nevertheless mutable through the procedural API. Test whether we are
+ ;; on that implementation.
+ (cond-expand
+ ((library (srfi 99))
+ (define using-broken-srfi99
+ (guard (err (else #f))
+ (rtd-mutator <foo> 'b))))
+ (else
+ (define using-broken-srfi99 #f)))
+
(define (run-tests)
(let ((runner (test-runner-create)))
(parameterize ((test-runner-current runner))
@@ -54,7 +80,9 @@
(test-assert "string" (char=? #\b (ref "abc" 1)))
(test-assert "vector" (= 1 (ref (vector 0 1 2) 1)))
(test-assert "record" (= 1 (ref (make-foo 0 1) 'b)))
- (test-skip (cond-expand ((library (srfi 4)) 0) (else 1)))
+ (cond-expand
+ ((library (srfi 4)) (values))
+ (else (test-skip 1)))
(test-assert "srfi-4" (= 1 (ref (s16vector 0 1 2) 1)))
(test-end "ref")
@@ -82,9 +110,13 @@
(test-assert "record" (let ((r (make-foo 0 1)))
(set! (ref r 'a) 2)
(= 2 (ref r 'a))))
+ (when using-broken-srfi99
+ (test-expect-fail 1))
(test-assert "bad record assignment"
(not (guard (err (else #f)) (set! (ref (make-foo 0 1) 'b) 2) #t)))
- (test-skip (cond-expand ((library (srfi 4)) 0) (else 1)))
+ (cond-expand
+ ((library (srfi 4)) (values))
+ (else (test-skip 1)))
(test-assert "srfi-4" (let ((s16v (s16vector 0 1 2)))
(set! (ref s16v 1) 3)
(= 3 (ref s16v 1))))
