[bug#63135] [PATCH v2 2/5] records: match-record: Display more helpful field-not-found error.

[(]

* guix/records.scm (match-record): Display MATCH-RECORD as the origin of
  "unknown record type field" errors.
Show the original MATCH-RECORD form, rather than an intermediate LOOKUP-FIELD
form, within said errors.
---
 guix/records.scm | 38 ++++++++++++++++++++------------------
 1 file changed, 20 insertions(+), 18 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index d8966998c1..4bee9d0aac 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -582,44 +582,46 @@ (define-syntax lookup-field
   (lambda (s)
     "Look up FIELD in the given list and return an expression that represents
 its offset in the record.  Raise a syntax violation when the field is not
-found."
+found, displaying it as originating in form S*."
     (syntax-case s ()
-      ((_ field offset ())
-       (syntax-violation 'lookup-field "unknown record type field"
-                         s #'field))
-      ((_ field offset (head tail ...))
+      ((_ s* field offset ())
+       (syntax-violation 'match-record
+                         "unknown record type field"
+                         #'s* #'field))
+      ((_ s* field offset (head tail ...))
        (free-identifier=? #'field #'head)
        #'offset)
-      ((_ field offset (_ tail ...))
-       #'(lookup-field field (+ 1 offset) (tail ...))))))
+      ((_ s* field offset (_ tail ...))
+       #'(lookup-field s* field (+ 1 offset) (tail ...))))))
 
 (define-syntax match-record-inner
   (lambda (s)
     (syntax-case s ()
-      ((_ record type ((field variable) rest ...) body ...)
+      ((_ s* record type ((field variable) rest ...) body ...)
        #'(let-syntax ((field-offset (syntax-rules ()
                                      ((_ f)
-                                       (lookup-field field 0 f)))))
+                                       (lookup-field s* field 0 f)))))
            (let* ((offset (type (map-fields type match-record) field-offset))
                   (variable (struct-ref record offset)))
-             (match-record-inner record type (rest ...) body ...))))
-      ((_ record type (field rest ...) body ...)
+             (match-record-inner s* record type (rest ...) body ...))))
+      ((_ s* record type (field rest ...) body ...)
        ;; Redirect to the canonical form above.
-       #'(match-record-inner record type ((field field) rest ...) body ...))
-      ((_ record type () body ...)
+       #'(match-record-inner s* record type ((field field) rest ...) body ...))
+      ((_ s* record type () body ...)
        #'(begin body ...)))))
 
 (define-syntax match-record
-  (syntax-rules ()
+  (lambda (s)
     "Bind each FIELD of a RECORD of the given TYPE to it's FIELD name.
 The order in which fields appear does not matter.  A syntax error is raised if
 an unknown field is queried.
 
 The current implementation does not support thunked and delayed fields."
     ;; TODO support thunked and delayed fields
-    ((_ record type (fields ...) body ...)
-     (if (eq? (struct-vtable record) type)
-         (match-record-inner record type (fields ...) body ...)
-         (throw 'wrong-type-arg record)))))
+    (syntax-case s ()
+      ((_ record type (fields ...) body ...)
+       #`(if (eq? (struct-vtable record) type)
+             (match-record-inner #,s record type (fields ...) body ...)
+             (throw 'wrong-type-arg record))))))
 
 ;;; records.scm ends here
-- 
2.39.2