[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[( via Guix-patches via]

Hello Guix,

Here are three patches pertaining to MATCH-RECORD; the first mostly by Josselin
Poiret, with modifications, and the latter two by me.  The former two improve
MATCH-RECORD's error reporting, and the last removes a TODO by adding support in
MATCH-RECORD for unpacking the values of fields marked THUNKED and DELAYED!

  -- (

( (3):
  records: match-record: Raise a syntax error if TYPE is nonexistent.
  records: match-record: Display more helpful field-not-found error.
  records: match-record: Support thunked and delayed fields.

 guix/records.scm  | 95 ++++++++++++++++++++++++++++++-----------------
 tests/records.scm | 29 +++++++++++++++
 2 files changed, 89 insertions(+), 35 deletions(-)

-- 
2.39.2

[bug#63135] [PATCH 1/3] records: match-record: Raise a syntax error if TYPE is nonexistent.

[( via Guix-patches via]

* guix/records.scm (match-record): Raise a human-compherensible syntax error
  if the given record type identifier is unbound.

Co-authored-by: Josselin Poiret <dev@jpoiret.xyz>
---
 guix/records.scm | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index 7d43b064d8..d8966998c1 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -105,7 +105,12 @@ (define (report-duplicate-field-specifier name ctor)
 
 (define-syntax map-fields
   (lambda (x)
-    (syntax-violation 'map-fields "bad use of syntactic keyword" x x)))
+    (syntax-case x ()
+      ((_ type within)
+       (syntax-violation (syntax->datum #'within)
+                         "undefined guix record-type"
+                         #'type))
+      (_ (syntax-violation 'map-fields "bad use of syntactic keyword" x x)))))
 
 (define-syntax-parameter this-record
   (lambda (s)
@@ -459,7 +464,7 @@ (define-syntax type
                    "This macro lets us query record type info at
 macro-expansion time."
                    (syntax-case s (map-fields)
-                     ((_ map-fields macro)
+                     ((_ (map-fields _ _) macro)
                       #'(macro (field ...)))
                      (id
                       (identifier? #'id)
@@ -595,7 +600,7 @@ (define-syntax match-record-inner
        #'(let-syntax ((field-offset (syntax-rules ()
 			              ((_ f)
                                        (lookup-field field 0 f)))))
-           (let* ((offset (type map-fields field-offset))
+           (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 ...)

base-commit: d59b4764f3171b1430a6d3b954659b8aab730475
-- 
2.39.2

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

[( via Guix-patches via]

* 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

[bug#63135] [PATCH 3/3] records: match-record: Support thunked and delayed fields.

[( via Guix-patches via]

* guix/records.scm (match-record): Unwrap matched thunked and delayed fields.
* tests/records.scm ("match-record, thunked field",
"match-record, delayed field"): New tests.
---
 guix/records.scm  | 60 ++++++++++++++++++++++++++++++-----------------
 tests/records.scm | 29 +++++++++++++++++++++++
 2 files changed, 68 insertions(+), 21 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index 4bee9d0aac..041eb2f297 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -21,6 +21,7 @@ (define-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:autoload (system base target) (target-most-positive-fixnum)
@@ -428,10 +429,19 @@ (define (compute-abi-cookie field-specs)
               (defaults   (filter-map field-default-value
                                       #'((field properties ...) ...)))
               (sanitizers (filter-map field-sanitizer
-                                        #'((field properties ...) ...)))
+                                      #'((field properties ...) ...)))
               (cookie     (compute-abi-cookie field-spec)))
          (with-syntax (((field-spec* ...)
                         (map field-spec->srfi-9 field-spec))
+                       ((field-type ...)
+                        (map (match-lambda
+                               ((? thunked-field?)
+                                (datum->syntax s 'thunked))
+                               ((? delayed-field?)
+                                (datum->syntax s 'delayed))
+                               (else
+                                (datum->syntax s 'normal)))
+                             field-spec))
                        ((thunked-field-accessor ...)
                         (filter-map (lambda (field)
                                       (and (thunked-field? field)
@@ -465,7 +475,7 @@ (define-syntax type
 macro-expansion time."
                    (syntax-case s (map-fields)
                      ((_ (map-fields _ _) macro)
-                      #'(macro (field ...)))
+                      #'(macro ((field field-type) ...)))
                      (id
                       (identifier? #'id)
                       #'#,(rtd-identifier #'type)))))
@@ -578,31 +588,42 @@ (define (recutils->alist port)
 ;;; Pattern matching.
 ;;;
 
-(define-syntax lookup-field
+(define-syntax lookup-field+wrapper
   (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, displaying it as originating in form S*."
-    (syntax-case s ()
-      ((_ s* field offset ())
+    "Look up FIELD in the given list and return both an expression that represents
+its offset in the record and a procedure that wraps it to return its \"true\" value
+(for instance, FORCE is returned in the case of a delayed field).  RECORD is passed
+to thunked values.  Raise a syntax violation when the field is not found, displaying
+it as originating in form S*."
+    (syntax-case s (normal delayed thunked)
+      ((_ s* record field offset ())
        (syntax-violation 'match-record
                          "unknown record type field"
                          #'s* #'field))
-      ((_ s* field offset (head tail ...))
+      ((_ s* record field offset ((head normal) tail ...))
+       (free-identifier=? #'field #'head)
+       #'(values offset identity))
+      ((_ s* record field offset ((head delayed) tail ...))
        (free-identifier=? #'field #'head)
-       #'offset)
-      ((_ s* field offset (_ tail ...))
-       #'(lookup-field s* field (+ 1 offset) (tail ...))))))
+       #'(values offset force))
+      ((_ s* record field offset ((head thunked) tail ...))
+       (free-identifier=? #'field #'head)
+       #'(values offset (cut <> record)))
+      ((_ s* record field offset (_ tail ...))
+       #'(lookup-field+wrapper s* record field
+                               (+ 1 offset) (tail ...))))))
 
 (define-syntax match-record-inner
   (lambda (s)
     (syntax-case s ()
       ((_ s* record type ((field variable) rest ...) body ...)
-       #'(let-syntax ((field-offset (syntax-rules ()
-			              ((_ f)
-                                       (lookup-field s* field 0 f)))))
-           (let* ((offset (type (map-fields type match-record) field-offset))
-                  (variable (struct-ref record offset)))
+       #'(let-syntax ((field-offset+wrapper
+                       (syntax-rules ()
+			 ((_ f)
+                          (lookup-field+wrapper s* record field 0 f)))))
+           (let* ((offset wrap (type (map-fields type match-record)
+                                     field-offset+wrapper))
+                  (variable (wrap (struct-ref record offset))))
              (match-record-inner s* record type (rest ...) body ...))))
       ((_ s* record type (field rest ...) body ...)
        ;; Redirect to the canonical form above.
@@ -614,10 +635,7 @@ (define-syntax match-record
   (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
+an unknown field is queried."
     (syntax-case s ()
       ((_ record type (fields ...) body ...)
        #`(if (eq? (struct-vtable record) type)
diff --git a/tests/records.scm b/tests/records.scm
index b1203dfeb7..4f0aeb3903 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -561,4 +561,33 @@ (define-record-type* <foo> foo make-foo
             (make-fresh-user-module)))
     (lambda (key . args) key)))
 
+(test-equal "match-record, delayed field"
+  "foo bar bar foo"
+  (begin
+    (define-record-type* <with-delayed> with-delayed make-with-delayed
+      with-delayed?
+      (delayed  with-delayed-delayed
+                (delayed)))
+
+    (let ((rec (with-delayed
+                (delayed "foo bar bar foo"))))
+      (match-record rec <with-delayed> (delayed)
+        delayed))))
+
+(test-equal "match-record, thunked field"
+  '("foo" "foobar")
+  (begin
+    (define-record-type* <with-thunked> with-thunked make-with-thunked
+      with-thunked?
+      (normal   with-thunked-normal)
+      (thunked  with-thunked-thunked
+                (thunked)))
+
+    (let ((rec (with-thunked
+                (normal  "foo")
+                (thunked (string-append (with-thunked-normal this-record)
+                                        "bar")))))
+      (match-record rec <with-thunked> (normal thunked)
+        (list normal thunked)))))
+
 (test-end)
-- 
2.39.2

[bug#63135] [PATCH v2 0/5] MATCH-RECORD improvements

[( via Guix-patches via]

This v2 fixes the dir-locals.el file so that it indents MATCH-RECORD
properly and adds a MATCH-RECORD-LAMBDA macro.

( (5):
  records: match-record: Raise a syntax error if TYPE is nonexistent.
  records: match-record: Display more helpful field-not-found error.
  records: match-record: Support thunked and delayed fields.
  dir-locals: Fix MATCH-RECORD indentation.
  records: Add MATCH-RECORD-LAMBDA.

 .dir-locals.el    |   3 +-
 guix/records.scm  | 110 +++++++++++++++++++++++++++++++---------------
 tests/records.scm |  41 +++++++++++++++++
 3 files changed, 117 insertions(+), 37 deletions(-)


base-commit: d59b4764f3171b1430a6d3b954659b8aab730475
-- 
2.39.2

[bug#63135] [PATCH v2 1/5] records: match-record: Raise a syntax error if TYPE is nonexistent.

[( via Guix-patches via]

* guix/records.scm (match-record): Raise a human-compherensible syntax error
  if the given record type identifier is unbound.

Co-authored-by: Josselin Poiret <dev@jpoiret.xyz>
---
 guix/records.scm | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index 7d43b064d8..d8966998c1 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -105,7 +105,12 @@ (define (report-duplicate-field-specifier name ctor)
 
 (define-syntax map-fields
   (lambda (x)
-    (syntax-violation 'map-fields "bad use of syntactic keyword" x x)))
+    (syntax-case x ()
+      ((_ type within)
+       (syntax-violation (syntax->datum #'within)
+                         "undefined guix record-type"
+                         #'type))
+      (_ (syntax-violation 'map-fields "bad use of syntactic keyword" x x)))))
 
 (define-syntax-parameter this-record
   (lambda (s)
@@ -459,7 +464,7 @@ (define-syntax type
                    "This macro lets us query record type info at
 macro-expansion time."
                    (syntax-case s (map-fields)
-                     ((_ map-fields macro)
+                     ((_ (map-fields _ _) macro)
                       #'(macro (field ...)))
                      (id
                       (identifier? #'id)
@@ -595,7 +600,7 @@ (define-syntax match-record-inner
        #'(let-syntax ((field-offset (syntax-rules ()
 			              ((_ f)
                                        (lookup-field field 0 f)))))
-           (let* ((offset (type map-fields field-offset))
+           (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 ...)
-- 
2.39.2

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[Ludovic Courtès]

Hi,

Thanks for these much welcome improvements!

"(" <paren@disroot.org> skribis:

> * guix/records.scm (match-record): Raise a human-compherensible syntax error
>   if the given record type identifier is unbound.

[...]

>  (define-syntax map-fields
>    (lambda (x)
> -    (syntax-violation 'map-fields "bad use of syntactic keyword" x x)))
> +    (syntax-case x ()
> +      ((_ type within)
> +       (syntax-violation (syntax->datum #'within)
> +                         "undefined guix record-type"
> +                         #'type))

How about “invalid record type identifier”?

(Rule of thumb: never use “Guix” in messages and interfaces.)

> -                     ((_ map-fields macro)
> +                     ((_ (map-fields _ _) macro)
>                        #'(macro (field ...)))
>                       (id
>                        (identifier? #'id)
> @@ -595,7 +600,7 @@ (define-syntax match-record-inner
>         #'(let-syntax ((field-offset (syntax-rules ()
>  			              ((_ f)
>                                         (lookup-field field 0 f)))))
> -           (let* ((offset (type map-fields field-offset))
> +           (let* ((offset (type (map-fields type match-record) field-offset))

There’s always a tradeoff; not a strong opinion but I’d lean towards
keeping the macro unchanged (thus a bit simpler) and simply changing the
default ‘syntax-violation’ message above.

WDYT?

Ludo’.

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

[( via Guix-patches via]

* 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

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[Ludovic Courtès]

"(" <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’.

[bug#63135] [PATCH v2 3/5] records: match-record: Support thunked and delayed fields.

[( via Guix-patches via]

* guix/records.scm (match-record): Unwrap matched thunked and delayed fields.
* tests/records.scm ("match-record, thunked field",
"match-record, delayed field"): New tests.
---
 guix/records.scm  | 60 ++++++++++++++++++++++++++++++-----------------
 tests/records.scm | 29 +++++++++++++++++++++++
 2 files changed, 68 insertions(+), 21 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index 4bee9d0aac..041eb2f297 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -21,6 +21,7 @@ (define-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:autoload (system base target) (target-most-positive-fixnum)
@@ -428,10 +429,19 @@ (define (compute-abi-cookie field-specs)
               (defaults   (filter-map field-default-value
                                       #'((field properties ...) ...)))
               (sanitizers (filter-map field-sanitizer
-                                        #'((field properties ...) ...)))
+                                      #'((field properties ...) ...)))
               (cookie     (compute-abi-cookie field-spec)))
          (with-syntax (((field-spec* ...)
                         (map field-spec->srfi-9 field-spec))
+                       ((field-type ...)
+                        (map (match-lambda
+                               ((? thunked-field?)
+                                (datum->syntax s 'thunked))
+                               ((? delayed-field?)
+                                (datum->syntax s 'delayed))
+                               (else
+                                (datum->syntax s 'normal)))
+                             field-spec))
                        ((thunked-field-accessor ...)
                         (filter-map (lambda (field)
                                       (and (thunked-field? field)
@@ -465,7 +475,7 @@ (define-syntax type
 macro-expansion time."
                    (syntax-case s (map-fields)
                      ((_ (map-fields _ _) macro)
-                      #'(macro (field ...)))
+                      #'(macro ((field field-type) ...)))
                      (id
                       (identifier? #'id)
                       #'#,(rtd-identifier #'type)))))
@@ -578,31 +588,42 @@ (define (recutils->alist port)
 ;;; Pattern matching.
 ;;;
 
-(define-syntax lookup-field
+(define-syntax lookup-field+wrapper
   (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, displaying it as originating in form S*."
-    (syntax-case s ()
-      ((_ s* field offset ())
+    "Look up FIELD in the given list and return both an expression that represents
+its offset in the record and a procedure that wraps it to return its \"true\" value
+(for instance, FORCE is returned in the case of a delayed field).  RECORD is passed
+to thunked values.  Raise a syntax violation when the field is not found, displaying
+it as originating in form S*."
+    (syntax-case s (normal delayed thunked)
+      ((_ s* record field offset ())
        (syntax-violation 'match-record
                          "unknown record type field"
                          #'s* #'field))
-      ((_ s* field offset (head tail ...))
+      ((_ s* record field offset ((head normal) tail ...))
+       (free-identifier=? #'field #'head)
+       #'(values offset identity))
+      ((_ s* record field offset ((head delayed) tail ...))
        (free-identifier=? #'field #'head)
-       #'offset)
-      ((_ s* field offset (_ tail ...))
-       #'(lookup-field s* field (+ 1 offset) (tail ...))))))
+       #'(values offset force))
+      ((_ s* record field offset ((head thunked) tail ...))
+       (free-identifier=? #'field #'head)
+       #'(values offset (cut <> record)))
+      ((_ s* record field offset (_ tail ...))
+       #'(lookup-field+wrapper s* record field
+                               (+ 1 offset) (tail ...))))))
 
 (define-syntax match-record-inner
   (lambda (s)
     (syntax-case s ()
       ((_ s* record type ((field variable) rest ...) body ...)
-       #'(let-syntax ((field-offset (syntax-rules ()
-			              ((_ f)
-                                       (lookup-field s* field 0 f)))))
-           (let* ((offset (type (map-fields type match-record) field-offset))
-                  (variable (struct-ref record offset)))
+       #'(let-syntax ((field-offset+wrapper
+                       (syntax-rules ()
+			 ((_ f)
+                          (lookup-field+wrapper s* record field 0 f)))))
+           (let* ((offset wrap (type (map-fields type match-record)
+                                     field-offset+wrapper))
+                  (variable (wrap (struct-ref record offset))))
              (match-record-inner s* record type (rest ...) body ...))))
       ((_ s* record type (field rest ...) body ...)
        ;; Redirect to the canonical form above.
@@ -614,10 +635,7 @@ (define-syntax match-record
   (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
+an unknown field is queried."
     (syntax-case s ()
       ((_ record type (fields ...) body ...)
        #`(if (eq? (struct-vtable record) type)
diff --git a/tests/records.scm b/tests/records.scm
index b1203dfeb7..4f0aeb3903 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -561,4 +561,33 @@ (define-record-type* <foo> foo make-foo
             (make-fresh-user-module)))
     (lambda (key . args) key)))
 
+(test-equal "match-record, delayed field"
+  "foo bar bar foo"
+  (begin
+    (define-record-type* <with-delayed> with-delayed make-with-delayed
+      with-delayed?
+      (delayed  with-delayed-delayed
+                (delayed)))
+
+    (let ((rec (with-delayed
+                (delayed "foo bar bar foo"))))
+      (match-record rec <with-delayed> (delayed)
+        delayed))))
+
+(test-equal "match-record, thunked field"
+  '("foo" "foobar")
+  (begin
+    (define-record-type* <with-thunked> with-thunked make-with-thunked
+      with-thunked?
+      (normal   with-thunked-normal)
+      (thunked  with-thunked-thunked
+                (thunked)))
+
+    (let ((rec (with-thunked
+                (normal  "foo")
+                (thunked (string-append (with-thunked-normal this-record)
+                                        "bar")))))
+      (match-record rec <with-thunked> (normal thunked)
+        (list normal thunked)))))
+
 (test-end)
-- 
2.39.2

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[Ludovic Courtès]

"(" <paren@disroot.org> skribis:

> * guix/records.scm (match-record): Unwrap matched thunked and delayed fields.
> * tests/records.scm ("match-record, thunked field",
> "match-record, delayed field"): New tests.

Yay! LGTM!

[bug#63135] [PATCH v2 4/5] dir-locals: Fix MATCH-RECORD indentation.

[( via Guix-patches via]

* .dir-locals.el: Treat the fourth form onwards as the body, rather than
  the third onwards.
---
 .dir-locals.el | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index a5f627a9ba..3ffd25ee94 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -70,7 +70,7 @@
    (eval . (put 'guard 'scheme-indent-function 1))
    (eval . (put 'lambda* 'scheme-indent-function 1))
    (eval . (put 'substitute* 'scheme-indent-function 1))
-   (eval . (put 'match-record 'scheme-indent-function 2))
+   (eval . (put 'match-record 'scheme-indent-function 3))
 
    ;; TODO: Contribute these to Emacs' scheme-mode.
    (eval . (put 'let-keywords 'scheme-indent-function 3))
-- 
2.39.2

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[Ludovic Courtès]

"(" <paren@disroot.org> skribis:

> * .dir-locals.el: Treat the fourth form onwards as the body, rather than
>   the third onwards.

Hmm that’s “incorrect”, no?

Currently we have:

  (match-record x <x>
    (field1 field2 …)
    body …)

Do you mean to move the field list on the first line?

Ludo’.

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[( via Guix-patches via]

Ludovic Courtès <ludo@gnu.org> writes:
> Hmm that’s “incorrect”, no?
>
> Currently we have:
>
>   (match-record x <x>
>     (field1 field2 …)
>     body …)
>
> Do you mean to move the field list on the first line?

Wait, that's intentional? :)  With this change, wouldn't it be:

```
(match-record x <x>
    (field1 field2)
  body ...)
```

which seems more in line with how other macros with bodies are typically
indented.

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[Ludovic Courtès]

"(" <paren@disroot.org> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>> Hmm that’s “incorrect”, no?
>>
>> Currently we have:
>>
>>   (match-record x <x>
>>     (field1 field2 …)
>>     body …)
>>
>> Do you mean to move the field list on the first line?
>
> Wait, that's intentional? :)  With this change, wouldn't it be:
>
> ```
> (match-record x <x>
>     (field1 field2)
>   body ...)
> ```
>
> which seems more in line with how other macros with bodies are typically
> indented.

Ah!  Dunno, to me the version you’re showing here looks “less natural”
because it’s a departure from ‘match’, which was the model here.

I understand this is all rather subjective…

Ludo’.

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[( via Guix-patches via]

Ludovic Courtès <ludo@gnu.org> writes:
> Ah!  Dunno, to me the version you’re showing here looks “less natural”
> because it’s a departure from ‘match’, which was the model here.
>
> I understand this is all rather subjective…

To me, the current indentation conflates the fields expression with the
body, which could be confusing for someone who'd never seen a
MATCH-RECORD form before.

  -- (

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[Ludovic Courtès]

Hi,

"(" <paren@disroot.org> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>> Ah!  Dunno, to me the version you’re showing here looks “less natural”
>> because it’s a departure from ‘match’, which was the model here.
>>
>> I understand this is all rather subjective…
>
> To me, the current indentation conflates the fields expression with the
> body, which could be confusing for someone who'd never seen a
> MATCH-RECORD form before.

Hmm yeah, that makes sense.

I’m fine with changing then, as long as ‘.dir-locals.el’ and (guix
read-print) implement the same rule.

Ludo’.

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[( via Guix-patches via]

Ludovic Courtès <ludo@gnu.org> writes:
> I’m fine with changing then, as long as ‘.dir-locals.el’ and (guix
> read-print) implement the same rule.

Ah, good point :)

[bug#63135] [PATCH v2 5/5] records: Add MATCH-RECORD-LAMBDA.

[( via Guix-patches via]

* guix/records.scm (match-record-lambda): New syntax.
* tests/records.scm ("match-record-lambda"): New test.
---
 .dir-locals.el    |  1 +
 guix/records.scm  | 15 ++++++++++++++-
 tests/records.scm | 12 ++++++++++++
 3 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index 3ffd25ee94..d79b5c9d7e 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -71,6 +71,7 @@
    (eval . (put 'lambda* 'scheme-indent-function 1))
    (eval . (put 'substitute* 'scheme-indent-function 1))
    (eval . (put 'match-record 'scheme-indent-function 3))
+   (eval . (put 'match-record-lambda 'scheme-indent-function 2))
 
    ;; TODO: Contribute these to Emacs' scheme-mode.
    (eval . (put 'let-keywords 'scheme-indent-function 3))
diff --git a/guix/records.scm b/guix/records.scm
index 041eb2f297..504a023e87 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -31,7 +31,8 @@ (define-module (guix records)
             alist->record
             object->fields
             recutils->alist
-            match-record))
+            match-record
+            match-record-lambda))
 
 ;;; Commentary:
 ;;;
@@ -642,4 +643,16 @@ (define-syntax match-record
              (match-record-inner #,s record type (fields ...) body ...)
              (throw 'wrong-type-arg record))))))
 
+(define-syntax match-record-lambda
+  (lambda (s)
+    "Return a procedure accepting a single record of the given TYPE for which each
+FIELD will be bound to its FIELD name within the returned procedure.  A syntax error
+is raised if an unknown field is queried."
+    (syntax-case s ()
+      ((_ type (field ...) body ...)
+       #`(lambda (record)
+           (if (eq? (struct-vtable record) type)
+               (match-record-inner #,s record type (field ...) body ...)
+               (throw 'wrong-type-arg record)))))))
+
 ;;; records.scm ends here
diff --git a/tests/records.scm b/tests/records.scm
index 4f0aeb3903..8ee306bddc 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -590,4 +590,16 @@ (define-record-type* <with-thunked> with-thunked make-with-thunked
       (match-record rec <with-thunked> (normal thunked)
         (list normal thunked)))))
 
+(test-equal "match-record-lambda"
+  '("thing: foo" "thing: bar")
+  (begin
+    (define-record-type* <with-text> with-text make-with-text
+      with-text?
+      (text with-text-text))
+
+    (map (match-record-lambda <with-text> (text)
+           (string-append "thing: " text))
+         (list (with-text (text "foo"))
+               (with-text (text "bar"))))))
+
 (test-end)
-- 
2.39.2

[bug#63135] [PATCH 0/3] MATCH-RECROD improvements

[Ludovic Courtès]

"(" <paren@disroot.org> skribis:

> * guix/records.scm (match-record-lambda): New syntax.
> * tests/records.scm ("match-record-lambda"): New test.

LGTM!

bug#63135: [PATCH v2 0/5] MATCH-RECORD improvements

[Josselin Poiret via Guix-patches via]

[-- Attachment #1: Type: text/plain, Size: 9001 bytes --]

Hi,

"(" <paren@disroot.org> writes:

> This v2 fixes the dir-locals.el file so that it indents MATCH-RECORD
> properly and adds a MATCH-RECORD-LAMBDA macro.
>
> ( (5):
>   records: match-record: Raise a syntax error if TYPE is nonexistent.
>   records: match-record: Display more helpful field-not-found error.
>   records: match-record: Support thunked and delayed fields.
>   dir-locals: Fix MATCH-RECORD indentation.
>   records: Add MATCH-RECORD-LAMBDA.
>
>  .dir-locals.el    |   3 +-
>  guix/records.scm  | 110 +++++++++++++++++++++++++++++++---------------
>  tests/records.scm |  41 +++++++++++++++++
>  3 files changed, 117 insertions(+), 37 deletions(-)

Thanks!

For some reason your From identity line messed up my patch mangling
tools, so I committed with (unmatched-paren instead of just ( as author.
Might be the emacs code I'm using that's hitting some corner cases.

Pushed as 178ffed3b7fe1784fff67b963c5c4bb667fbad2a with the
modifications below (that's a git-range-diff).  Basically, I dropped
"Display more helpful field-not-found error." since it was causing
issues when the body contained an ellipsis, and chose not to display the
total form that the error appeared in, but instead attach proper source
properties to the field syntax object in a new commit.  I also added a
test case for match-lambda with an ellipsis in the body, and added
match-record-lambda to (guix read-print).

1:  b2b374fafa = 1:  1a4aace3af records: match-record: Raise a syntax error if TYPE is nonexistent.
2:  1b3949cae7 < -:  ---------- records: match-record: Display more helpful field-not-found error.
3:  8def5ef633 ! 2:  b88e38d4b5 records: match-record: Support thunked and delayed fields.
    @@ guix/records.scm: (define (recutils->alist port)
        (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, displaying it as originating in form S*."
    +-found."
     -    (syntax-case s ()
    --      ((_ s* field offset ())
    +-      ((_ field offset ())
    +-       (syntax-violation 'lookup-field "unknown record type field"
     +    "Look up FIELD in the given list and return both an expression that represents
     +its offset in the record and a procedure that wraps it to return its \"true\" value
     +(for instance, FORCE is returned in the case of a delayed field).  RECORD is passed
    -+to thunked values.  Raise a syntax violation when the field is not found, displaying
    -+it as originating in form S*."
    ++to thunked values.  Raise a syntax violation when the field is not found."
     +    (syntax-case s (normal delayed thunked)
    -+      ((_ s* record field offset ())
    -        (syntax-violation 'match-record
    -                          "unknown record type field"
    -                          #'s* #'field))
    --      ((_ s* field offset (head tail ...))
    -+      ((_ s* record field offset ((head normal) tail ...))
    ++      ((_ record field offset ())
    ++       (syntax-violation 'match-record
    ++                         "unknown record type field"
    +                          s #'field))
    +-      ((_ field offset (head tail ...))
    ++      ((_ record field offset ((head normal) tail ...))
     +       (free-identifier=? #'field #'head)
     +       #'(values offset identity))
    -+      ((_ s* record field offset ((head delayed) tail ...))
    ++      ((_ record field offset ((head delayed) tail ...))
             (free-identifier=? #'field #'head)
     -       #'offset)
    --      ((_ s* field offset (_ tail ...))
    --       #'(lookup-field s* field (+ 1 offset) (tail ...))))))
    +-      ((_ field offset (_ tail ...))
    +-       #'(lookup-field field (+ 1 offset) (tail ...))))))
     +       #'(values offset force))
    -+      ((_ s* record field offset ((head thunked) tail ...))
    ++      ((_ record field offset ((head thunked) tail ...))
     +       (free-identifier=? #'field #'head)
     +       #'(values offset (cut <> record)))
    -+      ((_ s* record field offset (_ tail ...))
    -+       #'(lookup-field+wrapper s* record field
    ++      ((_ record field offset (_ tail ...))
    ++       #'(lookup-field+wrapper record field
     +                               (+ 1 offset) (tail ...))))))
      
      (define-syntax match-record-inner
        (lambda (s)
          (syntax-case s ()
    -       ((_ s* record type ((field variable) rest ...) body ...)
    +       ((_ record type ((field variable) rest ...) body ...)
     -       #'(let-syntax ((field-offset (syntax-rules ()
     -			              ((_ f)
    --                                       (lookup-field s* field 0 f)))))
    +-                                       (lookup-field field 0 f)))))
     -           (let* ((offset (type (map-fields type match-record) field-offset))
     -                  (variable (struct-ref record offset)))
     +       #'(let-syntax ((field-offset+wrapper
     +                       (syntax-rules ()
     +			 ((_ f)
    -+                          (lookup-field+wrapper s* record field 0 f)))))
    ++                          (lookup-field+wrapper record field 0 f)))))
     +           (let* ((offset wrap (type (map-fields type match-record)
     +                                     field-offset+wrapper))
     +                  (variable (wrap (struct-ref record offset))))
    -              (match-record-inner s* record type (rest ...) body ...))))
    -       ((_ s* record type (field rest ...) body ...)
    +              (match-record-inner record type (rest ...) body ...))))
    +       ((_ record type (field rest ...) body ...)
             ;; Redirect to the canonical form above.
     @@ guix/records.scm: (define-syntax match-record
    -   (lambda (s)
    +   (syntax-rules ()
          "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.
    @@ guix/records.scm: (define-syntax match-record
     -The current implementation does not support thunked and delayed fields."
     -    ;; TODO support thunked and delayed fields
     +an unknown field is queried."
    -     (syntax-case s ()
    -       ((_ record type (fields ...) body ...)
    -        #`(if (eq? (struct-vtable record) type)
    +     ((_ record type (fields ...) body ...)
    +      (if (eq? (struct-vtable record) type)
    +          (match-record-inner record type (fields ...) body ...)
     
      ## tests/records.scm ##
     @@ tests/records.scm: (define (location-alist loc)
4:  25d001ca8d = 3:  e6dc1d3996 dir-locals: Fix MATCH-RECORD indentation.
5:  384d6c9562 ! 4:  4cd5293621 records: Add MATCH-RECORD-LAMBDA.
    @@ .dir-locals.el
         ;; TODO: Contribute these to Emacs' scheme-mode.
         (eval . (put 'let-keywords 'scheme-indent-function 3))
     
    + ## guix/read-print.scm ##
    +@@ guix/read-print.scm: (define %special-forms
    +    ('letrec* 2)
    +    ('match 2)
    +    ('match-record 3)
    ++   ('match-record-lambda 2)
    +    ('when 2)
    +    ('unless 2)
    +    ('package 1)
    +
      ## guix/records.scm ##
     @@ guix/records.scm: (define-module (guix records)
                  alist->record
    @@ guix/records.scm: (define-module (guix records)
      ;;; Commentary:
      ;;;
     @@ guix/records.scm: (define-syntax match-record
    -              (match-record-inner #,s record type (fields ...) body ...)
    -              (throw 'wrong-type-arg record))))))
    +          (match-record-inner record type (fields ...) body ...)
    +          (throw 'wrong-type-arg record)))))
      
     +(define-syntax match-record-lambda
    -+  (lambda (s)
    ++  (syntax-rules ()
     +    "Return a procedure accepting a single record of the given TYPE for which each
     +FIELD will be bound to its FIELD name within the returned procedure.  A syntax error
     +is raised if an unknown field is queried."
    -+    (syntax-case s ()
    -+      ((_ type (field ...) body ...)
    -+       #`(lambda (record)
    -+           (if (eq? (struct-vtable record) type)
    -+               (match-record-inner #,s record type (field ...) body ...)
    -+               (throw 'wrong-type-arg record)))))))
    ++    ((_ type (field ...) body ...)
    ++     (lambda (record)
    ++       (if (eq? (struct-vtable record) type)
    ++           (match-record-inner record type (field ...) body ...)
    ++           (throw 'wrong-type-arg record))))))
     +
      ;;; records.scm ends here
     
-:  ---------- > 5:  f045c7ac80 records: match-record: Do not show internal form.
-:  ---------- > 6:  178ffed3b7 tests: records: Add test for ellipsis in body.

-- 
Josselin Poiret

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 682 bytes --]

[bug#63135] [PATCH v2 0/5] MATCH-RECORD improvements

[Josselin Poiret via Guix-patches via]

[-- Attachment #1: Type: text/plain, Size: 562 bytes --]

Hi again,

Josselin Poiret <dev@jpoiret.xyz> writes:

> For some reason your From identity line messed up my patch mangling
> tools, so I committed with (unmatched-paren instead of just ( as author.
> Might be the emacs code I'm using that's hitting some corner cases.

Just a heads-up, looking at the log on cgit made me realize that most of
the commits have a messed up author (still includes (unmatched-paren
<paren@disroot.org>, but also some extra stuff).  Apologies!  I'll try
to double check that in the future.

Best,
-- 
Josselin Poiret

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 682 bytes --]

[bug#63135] [PATCH v2 0/5] MATCH-RECORD improvements

[( via Guix-patches via]

Josselin Poiret <dev@jpoiret.xyz> writes:
> Thanks!

Reciprocated! :D

  -- (