diff options
author | Mark H Weaver <mhw@netris.org> | 2012-11-09 05:04:13 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2012-11-10 01:37:20 -0500 |
commit | 92fac8c056f8c2e61852625d48b5f7a8e66b72b9 (patch) | |
tree | ebf9659bff5783af70df0dd7a697e5fcad0611e7 /module/srfi/srfi-9.scm | |
parent | f31a0762328b9cffa328ce1540ceaa6f1497e083 (diff) | |
download | guile-92fac8c056f8c2e61852625d48b5f7a8e66b72b9.tar.gz |
Improve error for set-fields paths leading to different types.
* module/system/base/ck.scm: New module.
* module/srfi/srfi-9.scm: Import (system base ck).
(getter-type, getter-index, getter-copier): Convert incoming argument
convention to CK form.
(define-tagged-inlinable): Convert return value convention for key
lookup to CK form.
* module/srfi/srfi-9/gnu.scm: Import (system base ck).
Rename '%set-fields-unknown-getter' to 'unknown-getter'.
(c-list, c-same-type-check): New macros.
(%set-fields): Using the CK abstract machine, arrange to check (at
macro expansion time) that all of the getters in head position
correspond to the same record type.
* test-suite/tests/srfi-9.test: Add test.
Diffstat (limited to 'module/srfi/srfi-9.scm')
-rw-r--r-- | module/srfi/srfi-9.scm | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm index de4945952..d213a8656 100644 --- a/module/srfi/srfi-9.scm +++ b/module/srfi/srfi-9.scm @@ -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 ...) |