guile-srfi-123

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs

commit 63151bb7d267a40ef31660a4746ecb6f2c79bb04
parent a84b34e15756779c97367b221e412e854c49baef
Author: Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
Date:   Sun, 16 Aug 2015 20:24:21 +0200

Add register-getter-with-setter!.

Diffstat:
Msrfi-123.html | 6+++++-
Msrfi-123.md | 16++++++++++++----
Msrfi/123.body.scm | 45++++++++++++++++++++++++++-------------------
3 files changed, 43 insertions(+), 24 deletions(-)

diff --git a/srfi-123.html b/srfi-123.html @@ -103,8 +103,12 @@ class="antispam">nospam</span>srfi.schemers.org</a></code>. To subscribe to the <p>The corresponding <code>set!*</code> procedure is left out, but can be accessed as <code>(setter ref*)</code> when needed.</p> <pre><code>(define (store-item! field-chain value) (apply (setter ref*) the-store (append field-chain (list value))))</code></pre> +<ul> +<li><code>(register-getter-with-setter! type getter sparse?)</code> (procedure)</li> +</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 (as returned by the <code>getter-with-setter</code> procedure of SRFI-17), and <code>sparse?</code> is a Boolean indicating whether the type is a sparse type (see <code>ref</code> specification).</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 the semantics of their default <code>set!</code> operator in line with this SRFI, and add <code>ref</code> and <code>ref*</code> to their standard library. On the meanwhile, it 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 reference implementation can be used as a separate library, but certain considerations apply.</p> <p>The <code>set!</code> and <code>define-record-type</code> exports of the library conflict with the ones in <code>(scheme base)</code>, so either have to be renamed, or more typically, the ones 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> and <code>set!</code>.</p> <h2 id="implementation">Implementation</h2> diff --git a/srfi-123.md b/srfi-123.md @@ -234,14 +234,22 @@ as `(setter ref*)` when needed. (define (store-item! field-chain value) (apply (setter ref*) the-store (append field-chain (list value)))) +- `(register-getter-with-setter! type getter sparse?)` (procedure) + +Registers a new type/getter/setter triple for the dynamic dispatch. +`Type` is a type predicate, `getter` is a procedure that has a setter +associated with it (as returned by the `getter-with-setter` procedure +of SRFI-17), and `sparse?` is a Boolean indicating whether the type is +a sparse type (see `ref` specification). + Considerations when using as a library -------------------------------------- -The intent of this SRFI is to encourage Scheme systems to extend the -semantics of their default `set!` operator in line with this SRFI, and -add `ref` and `ref*` to their standard library. On the meanwhile, it -can be used as a separate library, but certain considerations apply. +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. The `set!` and `define-record-type` exports of the library conflict with the ones in `(scheme base)`, so either have to be renamed, or diff --git a/srfi/123.body.scm b/srfi/123.body.scm @@ -176,43 +176,50 @@ port? procedure? string? symbol? vector?) srfi-4-types)) +(define (register-getter-with-setter! type getter sparse?) + (push! type-list type) + (set! getter-table type getter) + (set! setter-table type (setter getter)) + (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> ...) - (push! type-list <pred>) - (register-record-getter <pred> <field> ...) - (register-record-setter <pred> <field> ...))))) + (register-getter-with-setter! + <pred> + (getter-with-setter (record-getter <field> ...) + (record-setter <field> ...)) + #f))))) -(define-syntax register-record-getter +(define-syntax record-getter (syntax-rules () - ((_ <pred> (<field> <getter> . <rest>) ...) + ((_ (<field> <getter> . <rest>) ...) (let ((getters (alist->hashtable (list (cons '<field> <getter>) ...)))) - (define (getter record field) + (lambda (record field) (let ((getter (or (ref getters field #f) (error "No such field of record." record field)))) - (getter record field))) - (set! getter-table <pred> getter))))) + (getter record field))))))) -(define-syntax register-record-setter +(define-syntax record-setter (syntax-rules () ((_ . <rest>) - (%register-record-setter () . <rest>)))) + (%record-setter () . <rest>)))) -(define-syntax %register-record-setter +(define-syntax %record-setter (syntax-rules () - ((_ <setters> <pred> (<field> <getter>) . <rest>) - (%register-record-setter <setters> <pred> . <rest>)) - ((_ <setters> <pred> (<field> <getter> <setter>) . <rest>) - (%register-record-setter ((<field> <setter>) . <setters>) <pred> . <rest>)) - ((_ ((<field> <setter>) ...) <pred>) + ((_ <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>) ...)))) - (define (setter record field value) + (lambda (record field value) (let ((setter (or (ref setters field #f) (error "No such assignable field of record." record field)))) - (setter record value))) - (set! setter-table <pred> setter))))) + (setter record value))))))) ;;; generic-ref-set.body.scm ends here