From 8ef3401f65aa661643629b170e1a9beec28d978f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 1 Jul 2012 17:32:03 +0200
Subject: [PATCH] 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'.
---
 guix/utils.scm | 23 ++++++++++++++++++-----
 1 file 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)