diff mbox series

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

Message ID 20230428191905.13860-3-paren@disroot.org
State New
Headers show
Series MATCH-RECORD improvements | expand

Commit Message

\( April 28, 2023, 7:19 p.m. UTC 
* 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(-)

Comments

Ludovic Courtès May 19, 2023, 3:25 p.m. UTC | #1 
"(" <paren@disroot.org> skribis:

> * 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.

[...]

>    (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 ())

Maybe ‘source’ or ‘form’ rather than ‘s*’?

Should we add a test in ‘tests/records.scm’ while we’re at it?

Otherwise LGTM!

Ludo’.
diff mbox series

Patch

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