commit 6799807d0094834ab6458b62def23cb5790016a4
parent 9b8a0b1e3c0deaf1ee3baa5d258973ef27c2a19e
Author: Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
Date: Mon, 7 Sep 2015 15:24:33 +0200
Add support for boxes.
Diffstat:
5 files changed, 71 insertions(+), 13 deletions(-)
diff --git a/srfi-123.html b/srfi-123.html
@@ -50,7 +50,7 @@ struct ;=> #(a (x y #u8(4 2 3)) c)</code></pre>
(define lst (list 0 1 table 3))
(ref* lst 2 "foo" 'x) ;error while accessing "foo" from table</code></pre>
<p>We believe the overhead involved in the dynamic dispatch is negligible in most cases, and furthermore a programmer can always fall back to type-specific accessor and modifier procedures in performance-critical sections of code.</p>
-<p>The operators are specified to work on bytevectors, R6RS hashtables, lists/pairs, strings, vectors, non-opaque record types, and SRFI-4 vectors if present. (R6RS and SRFI-99 can produce opaque record types; SRFI-9 and R7RS cannot.) Some notes on specific types:</p>
+<p>The operators are specified to work on bytevectors, R6RS hashtables, lists/pairs, strings, vectors, non-opaque record types, SRFI-4 vectors, and SRFI-111 boxes. (R6RS and SRFI-99 can produce opaque record types; SRFI-9 and R7RS cannot.) Some notes on specific types:</p>
<ul>
<li><p>For bytevectors, 8-bit unsigned integer operations are assumed. There is no obvious way to incorporate other bytevector operations into the generalized API, and a programmer is most likely to have single-byte operations in mind when using a generalized API on bytevectors.</p>
<pre><code>(define bv (bytevector 0 1 2 3))
@@ -72,6 +72,9 @@ struct ;=> #(a (x y #u8(4 2 3)) c)</code></pre>
(define foo (make-foo 0 1))
(ref foo 'a) ;=> 0
(set! (~ foo 'b) 2) ;error: No such assignable field of record.</code></pre></li>
+<li><p>For boxes, the symbol <code>*</code> is used to indicate the one value field of the box. This is mainly useful for <code>ref*</code>:</p>
+<pre><code>(define struct (list 0 (vector (box (cons 'a 'b)))))
+(ref* struct 1 0 '* 'cdr)</code></pre></li>
</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>
@@ -96,9 +99,10 @@ struct ;=> #(a (x y #u8(4 2 3)) c)</code></pre>
(ref hashtable unassigned-key) ;error</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, the symbols <code>car</code> and <code>cdr</code> are accepted, as well as non-negative integers as with <code>list-ref</code>. For records, symbols that correspond with the record type's field names are allowed.</p>
+<p>Valid types for <code>object</code> are: bytevectors, hashtables, pairs, strings, vectors, non-opaque record types, SRFI-4 vectors, and SRFI-111 boxes. 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, the symbols <code>car</code> and <code>cdr</code> are accepted, as well as non-negative integers as with <code>list-ref</code>. For records, symbols that correspond with the record type's field names are allowed. For boxes, the symbol <code>*</code> is used to denote the one value field of the box.</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>
+<p>A conforming implementation must also be prepared for boxes being a non-opaque record type instead of a disjoint type, and treat them correctly despite that fact.</p>
<p>The <code>ref</code> procedure has an associated SRFI-17 setter, although the one of <code>ref*</code> is strictly more powerful.</p>
<pre><code>(define vec (vector 0 1 2))
(set! (ref vec 0) 3)
diff --git a/srfi-123.md b/srfi-123.md
@@ -91,9 +91,9 @@ type-specific accessor and modifier procedures in performance-critical
sections of code.
The operators are specified to work on bytevectors, R6RS hashtables,
-lists/pairs, strings, vectors, non-opaque record types, and SRFI-4
-vectors if present. (R6RS and SRFI-99 can produce opaque record
-types; SRFI-9 and R7RS cannot.) Some notes on specific types:
+lists/pairs, strings, vectors, non-opaque record types, SRFI-4
+vectors, and SRFI-111 boxes. (R6RS and SRFI-99 can produce opaque
+record types; SRFI-9 and R7RS cannot.) Some notes on specific types:
- For bytevectors, 8-bit unsigned integer operations are assumed.
There is no obvious way to incorporate other bytevector operations
@@ -144,6 +144,14 @@ types; SRFI-9 and R7RS cannot.) Some notes on specific types:
(set! (~ foo 'b) 2) ;error: No such assignable field of record.
```
+- For boxes, the symbol `*` is used to indicate the one value field of
+ the box. This is mainly useful for `ref*`:
+
+ ```
+ (define struct (list 0 (vector (box (cons 'a 'b)))))
+ (ref* struct 1 0 '* 'cdr)
+ ```
+
Alists are difficult to support due to the lack of a reliable `alist?`
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
@@ -207,8 +215,8 @@ argument is an error.
(ref '(0 1 2) 3 'default) ;error: list-ref: Too many arguments.
Valid types for `object` 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
+vectors, non-opaque record types, SRFI-4 vectors, and SRFI-111 boxes.
+Only hashtables are a sparse type. Implementations are encouraged to
expand this list of types with any further types they support.
Valid types for `field` depend on the type of `object`. For
@@ -216,12 +224,17 @@ bytevectors, hashtables, strings, vectors, and SRFI-4 vectors, refer
to their respective `*-ref` procedures. For pairs, the symbols `car`
and `cdr` are accepted, as well as non-negative integers as with
`list-ref`. For records, symbols that correspond with the record
-type's field names are allowed.
+type's field names are allowed. For boxes, the symbol `*` is used to
+denote the one value field of the box.
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.
+A conforming implementation must also be prepared for boxes being a
+non-opaque record type instead of a disjoint type, and treat them
+correctly despite that fact.
+
The `ref` procedure has an associated SRFI-17 setter, although the one
of `ref*` is strictly more powerful.
diff --git a/srfi/123.body.scm b/srfi/123.body.scm
@@ -134,6 +134,22 @@
(define bytevector-ref bytevector-u8-ref)
(define bytevector-set! bytevector-u8-set!)))
+;;; SRFI-111 boxes support
+
+(cond-expand
+ ((library (srfi 111))
+ (define (box-ref box _field)
+ (unbox box))
+ (define (box-set! box _field value)
+ (set-box! box value))
+ (define box-getters (list (cons box? box-ref)))
+ (define box-setters (list (cons box? box-set!)))
+ (define box-types (list box?)))
+ (else
+ (define box-getters '())
+ (define box-setters '())
+ (define box-types '())))
+
;;; Main
(define %ref
@@ -202,7 +218,8 @@
(cons string? string-ref)
(cons vector? vector-ref))
record-getters
- srfi-4-getters)))
+ srfi-4-getters
+ box-getters)))
(define setter-table
(alist->hashtable
@@ -213,7 +230,8 @@
(cons string? string-set!)
(cons vector? vector-set!))
record-setters
- srfi-4-setters)))
+ srfi-4-setters
+ box-setters)))
(define sparse-types
(list hashtable?))
@@ -222,8 +240,10 @@
(append
(list boolean? bytevector? char? eof-object? hashtable? null? number? pair?
port? procedure? string? symbol? vector?)
- record-types
- srfi-4-types))
+ srfi-4-types
+ box-types
+ ;; Place records last so specific record types (e.g. box) take precedence.
+ record-types))
(define (register-getter-with-setter! type getter sparse?)
(push! type-list type)
diff --git a/srfi/123.sld b/srfi/123.sld
@@ -32,4 +32,8 @@
((library (srfi 4))
(import (srfi 4)))
(else))
+ (cond-expand
+ ((library (srfi 111))
+ (import (srfi 111)))
+ (else))
(include "123.body.scm"))
diff --git a/tests/srfi-123.sld b/tests/srfi-123.sld
@@ -46,6 +46,13 @@
(begin
;; Stub to silence compilers.
(define s16vector #f))))
+ (cond-expand
+ ((library (srfi 111))
+ (import (srfi 111)))
+ (else
+ (begin
+ ;; Stub to silence compilers.
+ (define box #f))))
(begin
(define-record-type <foo> (make-foo a b) foo?
@@ -84,6 +91,10 @@
((library (srfi 4)) (values))
(else (test-skip 1)))
(test-assert "srfi-4" (= 1 (ref (s16vector 0 1 2) 1)))
+ (cond-expand
+ ((library (srfi 111)) (values))
+ (else (test-skip 1)))
+ (test-assert "srfi-111" (= 1 (ref (box 1) '*)))
(test-end "ref")
(test-assert "ref*" (= 1 (ref* '(_ #(_ (0 . 1) _) _) 1 1 'cdr)))
@@ -120,6 +131,12 @@
(test-assert "srfi-4" (let ((s16v (s16vector 0 1 2)))
(set! (ref s16v 1) 3)
(= 3 (ref s16v 1))))
+ (cond-expand
+ ((library (srfi 111)) (values))
+ (else (test-skip 1)))
+ (test-assert "srfi-111" (let ((b (box 0)))
+ (set! (ref b '*) 1)
+ (= 1 (ref b '*))))
(test-end "ref setter")
(test-assert "ref* setter"
