nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
This commit is contained in:
Ludovic Courtès 2012-07-01 17:32:03 +02:00
parent 888f72e97f
commit 8ef3401f65
1 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/utils.scm
View File

@ -30,6 +30,7 @@
#:autoload (ice-9 rdelim) (read-line) #:autoload (ice-9 rdelim) (read-line)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format)
#:autoload (system foreign) (pointer->procedure) #:autoload (system foreign) (pointer->procedure)
#:export (bytevector-quintet-length #:export (bytevector-quintet-length
bytevector->base32-string bytevector->base32-string
@ -493,11 +494,23 @@ tuples."
((_ v) v) ((_ v) v)
(#f (car (assoc-ref dflt f))))) (#f (car (assoc-ref dflt f)))))
(if (lset= eq? (append fields (map car dflt)) (let-syntax ((error*
'expected) (syntax-rules ()
#`(ctor #,@(map field-value 'expected)) ((_ fmt args (... ...))
(error "missing or extraneous field initializers" (syntax-violation 'name
(lset-difference eq? fields 'expected)))))))))) (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) (define (field-default-value s)
(syntax-case s (default) (syntax-case s (default)