[PATCH 0/3] MATCH-RECROD improvements

  • Done
  • quality assurance status badge
Details
3 participants
  • Josselin Poiret
  • Ludovic Courtès
  • (
Owner
unassigned
Submitted by
(
Severity
normal
(
(address . guix-patches@gnu.org)
20230427220452.4972-1-paren@disroot.org
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
(
[PATCH 1/3] records: match-record: Raise a syntax error if TYPE is nonexistent.
(address . 63135@debbugs.gnu.org)
20230427220653.5228-1-paren@disroot.org
* 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(-)

Toggle diff (40 lines)
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
(
[PATCH 2/3] records: match-record: Display more helpful field-not-found error.
(address . 63135@debbugs.gnu.org)
20230427220653.5228-2-paren@disroot.org
* 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(-)

Toggle diff (71 lines)
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
(
[PATCH 3/3] records: match-record: Support thunked and delayed fields.
(address . 63135@debbugs.gnu.org)
20230427220653.5228-3-paren@disroot.org
* 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(-)

Toggle diff (152 lines)
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
(
[PATCH v2 0/5] MATCH-RECORD improvements
(address . 63135@debbugs.gnu.org)
20230428191905.13860-1-paren@disroot.org
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
(
[PATCH v2 4/5] dir-locals: Fix MATCH-RECORD indentation.
(address . 63135@debbugs.gnu.org)
20230428191905.13860-5-paren@disroot.org
* .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(-)

Toggle diff (15 lines)
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
(
[PATCH v2 2/5] records: match-record: Display more helpful field-not-found error.
(address . 63135@debbugs.gnu.org)
20230428191905.13860-3-paren@disroot.org
* 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(-)

Toggle diff (71 lines)
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
(
[PATCH v2 5/5] records: Add MATCH-RECORD-LAMBDA.
(address . 63135@debbugs.gnu.org)
20230428191905.13860-6-paren@disroot.org
* 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(-)

Toggle diff (66 lines)
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
(
[PATCH v2 3/5] records: match-record: Support thunked and delayed fields.
(address . 63135@debbugs.gnu.org)
20230428191905.13860-4-paren@disroot.org
* 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(-)

Toggle diff (152 lines)
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
(
[PATCH v2 1/5] records: match-record: Raise a syntax error if TYPE is nonexistent.
(address . 63135@debbugs.gnu.org)
20230428191905.13860-2-paren@disroot.org
* 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(-)

Toggle diff (38 lines)
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
L
L
Ludovic Courtès wrote on 19 May 2023 17:22
Re: bug#63135: [PATCH 0/3] MATCH-RECROD improvements
(name . ()(address . paren@disroot.org)
87h6s8xs53.fsf_-_@gnu.org
Hi,

Thanks for these much welcome improvements!

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

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

[...]

Toggle quote (9 lines)
> (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.)

Toggle quote (12 lines)
> - ((_ 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’.
L
L
Ludovic Courtès wrote on 19 May 2023 17:25
(name . ()(address . paren@disroot.org)
87cz2wxs0i.fsf_-_@gnu.org
"(" <paren@disroot.org> skribis:

Toggle quote (5 lines)
> * 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.

[...]

Toggle quote (12 lines)
> (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’.
L
L
Ludovic Courtès wrote on 19 May 2023 17:25
(name . ()(address . paren@disroot.org)
878rdkxrzs.fsf_-_@gnu.org
"(" <paren@disroot.org> skribis:

Toggle quote (4 lines)
> * 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!
L
L
Ludovic Courtès wrote on 19 May 2023 17:27
(name . ()(address . paren@disroot.org)
874jo8xrx2.fsf_-_@gnu.org
"(" <paren@disroot.org> skribis:

Toggle quote (3 lines)
> * .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’.
L
L
Ludovic Courtès wrote on 19 May 2023 17:28
(name . ()(address . paren@disroot.org)
87zg60wdbc.fsf_-_@gnu.org
"(" <paren@disroot.org> skribis:

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

LGTM!
(
(name . Ludovic Courtès)(address . ludo@gnu.org)
87mt1ykhg5.fsf@disroot.org
Ludovic Courtès <ludo@gnu.org> writes:
Toggle quote (10 lines)
> 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.
L
L
Ludovic Courtès wrote on 24 May 2023 16:11
(name . ()(address . paren@disroot.org)
87o7m9lszg.fsf@gnu.org
"(" <paren@disroot.org> skribis:

Toggle quote (22 lines)
> 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’.
(
(name . Ludovic Courtès)(address . ludo@gnu.org)
87353lhgo0.fsf@disroot.org
Ludovic Courtès <ludo@gnu.org> writes:
Toggle quote (5 lines)
> 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.

-- (
L
L
Ludovic Courtès wrote on 26 May 2023 18:41
(name . ()(address . paren@disroot.org)
87pm6nhwpn.fsf@gnu.org
Hi,

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

Toggle quote (10 lines)
> 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’.
(
(name . Ludovic Courtès)(address . ludo@gnu.org)
87353i384l.fsf@disroot.org
Ludovic Courtès <ludo@gnu.org> writes:
Toggle quote (3 lines)
> I’m fine with changing then, as long as ‘.dir-locals.el’ and (guix
> read-print) implement the same rule.

Ah, good point :)
J
J
Josselin Poiret wrote on 4 Jun 2023 11:47
Re: [PATCH v2 0/5] MATCH-RECORD improvements
(name . ()(address . paren@disroot.org)
878rczeeze.fsf@jpoiret.xyz
Hi,

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

Toggle quote (15 lines)
> 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
-----BEGIN PGP SIGNATURE-----

iQHEBAEBCgAuFiEEOSSM2EHGPMM23K8vUF5AuRYXGooFAmR8XaUQHGRldkBqcG9p
cmV0Lnh5egAKCRBQXkC5FhcaiiqdDACzw0Zo+U4MSZDB/+npEQekhFdhwHHiJT1Q
8dhvp2OTCNcBlnyx8vg2KEqz+OmCAmD3En+r8yH3EJdILyMomKsHVtNmmxwgQW7H
g1GTd0lbeoy9tXqOwwutxUkWfh7l2gXBwNQlJ2taHneNZKSmoxabFMRMa4Py9S9V
93a6K/zCAyYXcTK1OgEgWKgkoIgOMqqr6sghpxVRcewwHF2o6Y+YSgUbdkQM1rQE
MV7rsrvNdJUdwY68pcUuXy07lagXfkKODMoO1Laj8WBJThAxLxEZd2xej6BSXjWg
lIghPWnYgndBzV+26zKk8EPM7OISrg4yIi3Lc9CZGZ8TtrPThSciEnr+iT6zgWFY
oEXBnyRK9LFnTjVdMYBDrmqSW9xxzlobaFWAMFN9+ZPl1UT1Inrb0gbGtPC4zpHN
0JSj/K/B8KkkEYg0ERODcEr5zW9PfNCymcgpZ7eDj8RFREBm4AxpKyyd7hjV3cU6
QNzbR11VLA/xQ6kl4oH1GJ7R8kVbL68=
=uaXt
-----END PGP SIGNATURE-----

Closed
J
J
Josselin Poiret wrote on 4 Jun 2023 12:48
(name . ()(address . paren@disroot.org)
87ilc3y035.fsf@jpoiret.xyz
Hi again,

Josselin Poiret <dev@jpoiret.xyz> writes:

Toggle quote (4 lines)
> 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
-----BEGIN PGP SIGNATURE-----

iQHEBAEBCgAuFiEEOSSM2EHGPMM23K8vUF5AuRYXGooFAmR8bA4QHGRldkBqcG9p
cmV0Lnh5egAKCRBQXkC5FhcaijwaC/9KWwF0FVyxv4pgU8TwbtiqDWhCkopZ63Cn
B02VB7ruJoIbkNCgDaryBCckcEPQC1/FdkNrb9T4XDcqvJWFuhgn8M/s7vO/oJQg
ZnT0nfIdy3Xt5AcJ/0vAnKRk+zYCnufK5C8dP+fK7hSgJ8ryVL5nr0qknWOzBGOZ
31HmMFodurk+bTrnbfhmXfq+DZGqsVrtG7IYfmZ8SsTkjG90VkyQ+3Kq5y9LHsI2
h1z6nZhSmLeQ9B9/PDp+rJWybzvqxZbN9AOTaBzH+1AYNJrP6KgKp391+tuVXXr+
+urFk/RoB117Y9i073u5RZsLnaB4JKt9xuVlND4aexYMseytToQH1c5YEygc+/OZ
yJolpjiFYeFVjtjLSZH6jyouwL2I/mIy85GJbBq4qiHZ29PPkdIyW1aSGCecEcLB
BFA5JDCiVrizfVlUzW4ZC5FbsZvJhBE4nuSM8681X5YXaVn21Bpz7uSyDxjTbAbT
iQlBFBbrcASmSj1mQ1XhR8PboNxArag=
=qfZ8
-----END PGP SIGNATURE-----

Closed
(
(name . Josselin Poiret)(address . dev@jpoiret.xyz)(address . 63135-done@debbugs.gnu.org)
87bkhvqbzc.fsf@disroot.org
Josselin Poiret <dev@jpoiret.xyz> writes:
Toggle quote (2 lines)
> Thanks!

Reciprocated! :D

-- (
Closed
?