records: Let thunked fields refer to their inherited value.

* guix/records.scm (make-syntactic-constructor)[field-index]: New procedure.
[wrap-field-value]: Add optional argument ‘parent’.  When it is true, bind F
to the inherited field value.
[field-bindings/inheritance]: New procedure.
Use it.
* tests/records.scm ("define-record-type* & thunked & no inherited value")
("define-record-type* & thunked & inherited value")
("define-record-type* & thunked & inherited value & this-record"): New tests.
* doc/guix.texi (Defining Package Variants): Update ‘modify-inputs’ example to
refer to ‘inputs’.
(Writing Manifests): Likewise.
* doc/guix-cookbook.texi (Package Variants): Likewise for
‘substitute-keyword-arguments’.

Fixes: https://issues.guix.gnu.org/50335
Change-Id: If4e18155ce203637ff9e116ee8098f8997bfebe2

4 files changed, 131 insertions, 19 deletions

diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi
index 4b6f0ca22c0..83bce66c175 100644
--- a/doc/guix-cookbook.texi
+++ b/doc/guix-cookbook.texi
@@ -5297,7 +5297,7 @@ did above with transformation options. We can add them like so:
   "Return P with FLAGS as additional 'configure' flags."
   (package/inherit p
     (arguments
-     (substitute-keyword-arguments (package-arguments p)
+     (substitute-keyword-arguments arguments
        ((#:configure-flags original-flags #~(list))
         #~(append #$original-flags #$flags))))))
 
diff --git a/doc/guix.texi b/doc/guix.texi
index e7bcd174a8e..d5f782f35c4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8800,14 +8800,15 @@ dependency like so:
 (define gdb-sans-guile
   (package
     (inherit gdb)
-    (inputs (modify-inputs (package-inputs gdb)
+    (inputs (modify-inputs inputs
               (delete "guile")))))
 @end lisp
 
-The @code{modify-inputs} form above removes the @code{"guile"} package
-from the @code{inputs} field of @code{gdb}.  The @code{modify-inputs}
-macro is a helper that can prove useful anytime you want to remove, add,
-or replace package inputs.
+In the body of the @code{inputs} field above, @code{inputs} is bound to
+the inherited value.  Thus, the @code{modify-inputs} form above removes
+the @code{"guile"} package from the @code{inputs} field of @code{gdb}.
+The @code{modify-inputs} macro is a helper that can prove useful anytime
+you want to remove, add, or replace package inputs.
 
 @defmac modify-inputs inputs clauses
 Modify the given package inputs, as returned by @code{package-inputs} & co.,
@@ -9131,7 +9132,7 @@ these lines:
 (define gdb-sans-guile
   (package
     (inherit gdb)
-    (inputs (modify-inputs (package-inputs gdb)
+    (inputs (modify-inputs inputs
               (delete "guile")))))
 
 ;; Return a manifest containing that one package plus Git.
diff --git a/guix/records.scm b/guix/records.scm
index 261f6f07b6c..bf746d3b5d9 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2025 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2026 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -192,18 +192,55 @@ of TYPE matches the expansion-time ABI."
                (or (and=> (assoc-ref lst (syntax->datum f)) car)
                    #'(lambda (x) x)))))
 
-         (define (wrap-field-value f value)
+         (define (field-index f)
+           ;; Return the index of F within the record.
+           (let ((f (syntax->datum f)))
+             (let loop ((fields '(expected ...))
+                        (index 0))
+               (match fields
+                 (()
+                  ;; Internal error.
+                  (record-error 'name s "field not found ~a" f))
+                 ((head . rest)
+                  (if (eq? f head)
+                      index
+                      (loop rest (+ 1 index))))))))
+
+         (define* (wrap-field-value f value #:optional parent)
+           ;; Wrap VALUE, the value of field F, such that its sanitizer is
+           ;; called and its properties (thunked, delayed) honored.  When
+           ;; PARENT is true, bind F to the value inherited from PARENT in the
+           ;; lexical scope of VALUE.
            (let* ((sanitizer (field-sanitizer f))
                   (value     #`(#,sanitizer #,value)))
              (cond ((thunked-field? f)
-                    #`(lambda (x)
-                        (syntax-parameterize ((#,this-identifier
-                                               (lambda (s)
-                                                 (syntax-case s ()
-                                                   (id
-                                                    (identifier? #'id)
-                                                    #'x)))))
-                          #,value)))
+                    (if parent
+                        ;; Compute the value being inherited by calling the
+                        ;; thunked field F of PARENT with a self-reference for
+                        ;; the new record being constructed.
+                        (with-syntax ((inherited
+                                       #`((struct-ref #,parent
+                                                      #,(field-index f))
+                                          #,this-identifier)))
+                          #`(lambda (x)
+                              (syntax-parameterize ((#,this-identifier
+                                                     (lambda (s)
+                                                       (syntax-case s ()
+                                                         (id
+                                                          (identifier? #'id)
+                                                          #'x)))))
+                                ;; Bind F, the field identifier, to the value
+                                ;; being inherited.
+                                (let-syntax ((#,f (identifier-syntax inherited)))
+                                  #,value))))
+                        #`(lambda (x)
+                            (syntax-parameterize ((#,this-identifier
+                                                   (lambda (s)
+                                                     (syntax-case s ()
+                                                       (id
+                                                        (identifier? #'id)
+                                                        #'x)))))
+                              #,value))))
                    ((delayed-field? f)
                     #`(delay #,value))
                    (else value))))
@@ -227,9 +264,19 @@ of TYPE matches the expansion-time ABI."
                         #,(wrap-field-value #'field #'value)))))
                 field+value))
 
+         (define (field-bindings/inheritance parent field+value)
+           ;; Return field to value bindings, for use in 'let*' below.
+           (map (lambda (field+value)
+                  (syntax-case field+value ()
+                    ((field value)
+                     #`(field
+                        #,(wrap-field-value #'field #'value parent)))))
+                field+value))
+
          (syntax-case s (inherit expected ...)
            ((_ (inherit orig-record) (field value) (... ...))
-            #`(let* #,(field-bindings #'((field value) (... ...)))
+            #`(let* #,(field-bindings/inheritance #'orig-record
+                                                  #'((field value) (... ...)))
                 #,(abi-check #'type abi-cookie)
                 #,(record-inheritance #'orig-record
                                       #'((field value) (... ...)))))
diff --git a/tests/records.scm b/tests/records.scm
index 5464892d3b5..9c071334d50 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2016, 2018-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2016, 2018-2022, 2026 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -238,6 +238,70 @@
               (bar? first)
               (eq? first y)))))))
 
+(test-equal "define-record-type* & thunked & no inherited value"
+  '(baz)                                          ;the unbound variable
+  (catch 'unbound-variable
+    (lambda ()
+      (eval '(begin
+               (define-record-type* <foo> foo make-foo
+                 foo?
+                 (bar foo-bar)
+                 (baz foo-baz (thunked)))
+
+               ;; There's no inheritance here so 'baz' is unbound in the field
+               ;; body.  Call 'foo-baz' to trigger to unbound variable error.
+               (foo-baz (foo (bar 1) (baz baz))))
+            (test-module)))
+    (lambda (key proc message arguments . rest)
+      arguments)))
+
+(test-equal "define-record-type* & thunked & inherited value"
+  '(1 22)
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar)
+      (baz foo-baz (thunked)))
+
+    (let* ((parent (foo (bar 1) (baz 2)))
+           (child (foo (inherit parent)
+                       (baz (* baz 11)))))
+      (list (foo-bar child) (foo-baz child)))))
+
+(test-equal "define-record-type* & thunked & inherited value & this-record"
+  '((1 2) => (21 (inherited . 42)))
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar)
+      (baz foo-baz (thunked)))
+
+    (let* ((parent (foo (bar 1)
+                        (baz (* 2 (foo-bar this-record)))))
+           (child (foo (inherit parent)
+                       (bar 21)
+                       (baz (cons 'inherited baz)))))
+      `((,(foo-bar parent) ,(foo-baz parent))
+        =>
+        (,(foo-bar child) ,(foo-baz child))))))
+
+(test-equal "define-record-type* & thunked & inherited value & sanitizer"
+  '((1 "2") => (4 "88"))
+  (begin
+    (define-record-type* <foo> foo make-foo
+      foo?
+      (bar foo-bar)
+      (baz foo-baz (thunked) (sanitize number->string)))
+
+    (let* ((parent (foo (bar 1)
+                        (baz (* 2 (foo-bar this-record)))))
+           (child (foo (inherit parent)
+                       (bar 4)
+                       (baz (+ 80 (string->number baz))))))
+      `((,(foo-bar parent) ,(foo-baz parent))
+        =>
+        (,(foo-bar child) ,(foo-baz child))))))
+
 (test-assert "define-record-type* & delayed"
   (begin
     (define-record-type* <foo> foo make-foo