From b1353e7a6baf15e6e1db79063c01f4b07b6d4e06 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 17 Jul 2014 16:42:19 +0200
Subject: [PATCH] records: Factorize error-reporting macro.

* guix/records.scm (record-error): New macro.
  (define-record-type*)[error*]: Remove.
  Use 'record-error' instead.
---
 guix/records.scm | 44 ++++++++++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 20 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index 37d34b4c81..e60732dd43 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,6 +34,14 @@
 ;;;
 ;;; Code:
 
+(define-syntax record-error
+  (syntax-rules ()
+    "Report a syntactic error in use of CONSTRUCTOR."
+    ((_ constructor form fmt args ...)
+     (syntax-violation constructor
+                       (format #f fmt args ...)
+                       form))))
+
 (define-syntax define-record-type*
   (lambda (s)
     "Define the given record type such that an additional \"syntactic
@@ -107,25 +115,21 @@ thunked fields."
                                #`(lambda () #,value)
                                value))))
 
-                   (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)
-                              #`(let* #,(field-bindings
-                                         #'((field value) (... ...)))
-                                  (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)))))))))))))
+                   (let ((fields (append fields (map car dflt))))
+                     (cond ((lset= eq? fields 'expected)
+                            #`(let* #,(field-bindings
+                                       #'((field value) (... ...)))
+                                (ctor #,@(map field-value 'expected))))
+                           ((pair? (lset-difference eq? fields 'expected))
+                            (record-error 'name s
+                                          "extraneous field initializers ~a"
+                                          (lset-difference eq? fields
+                                                           'expected)))
+                           (else
+                            (record-error 'name s
+                                          "missing field initializers ~a"
+                                          (lset-difference eq? 'expected
+                                                           fields))))))))))))
 
     (define (field-default-value s)
       (syntax-case s (default)