diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2012-07-01 17:32:03 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2012-07-02 15:37:30 +0200 |
| commit | 8ef3401f65aa661643629b170e1a9beec28d978f (patch) | |
| tree | d49c84ca4487d63c2fd79ede220415b4173fbbc2 | |
| parent | 888f72e97f710a0292fb5eee92179f6e19990fd8 (diff) | |
| download | guix-8ef3401f65aa661643629b170e1a9beec28d978f.tar.gz | |
Make `define-record-type*' error messages more informative.
* guix/utils.scm (define-record-type*): In case of missing or extra field initializers, raise a descriptive `syntax-error'.
| -rw-r--r-- | guix/utils.scm | 23 |
1 files changed, 18 insertions, 5 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index 46983dc1bc..ed13bae307 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -30,6 +30,7 @@ #:autoload (ice-9 rdelim) (read-line) #:use-module (ice-9 regex) #:use-module (ice-9 match) + #:use-module (ice-9 format) #:autoload (system foreign) (pointer->procedure) #:export (bytevector-quintet-length bytevector->base32-string @@ -493,11 +494,23 @@ tuples." ((_ v) v) (#f (car (assoc-ref dflt f))))) - (if (lset= eq? (append fields (map car dflt)) - 'expected) - #`(ctor #,@(map field-value 'expected)) - (error "missing or extraneous field initializers" - (lset-difference eq? fields 'expected)))))))))) + (let-syntax ((error* + (syntax-rules () + ((_ fmt args (... ...)) + (syntax-violation 'name + (format #f fmt args + (... ...)) + s))))) + (let ((fields (append fields (map car dflt)))) + (cond ((lset= eq? fields 'expected) + #`(ctor #,@(map field-value 'expected))) + ((pair? (lset-difference eq? fields 'expected)) + (error* "extraneous field initializers ~a" + (lset-difference eq? fields 'expected))) + (else + (error* "missing field initializers ~a" + (lset-difference eq? 'expected + fields))))))))))))) (define (field-default-value s) (syntax-case s (default) |