aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-07-01 17:32:03 +0200
committerLudovic Courtès <ludo@gnu.org>2012-07-02 15:37:30 +0200
commit8ef3401f65aa661643629b170e1a9beec28d978f (patch)
treed49c84ca4487d63c2fd79ede220415b4173fbbc2
parent888f72e97f710a0292fb5eee92179f6e19990fd8 (diff)
downloadguix-8ef3401f65aa661643629b170e1a9beec28d978f.tar.gz
guix-8ef3401f65aa661643629b170e1a9beec28d978f.zip
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.scm23
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)