ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Make `define-record-type*' error messages more informative.

Browse source 
* 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 @@ (define-module (guix utils)
#: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 @@ (define (field-value f)
((_ 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)