Subject: [bug#29296] [PATCH 1/2] gexp: Compilers can now return lowerable objects.

From: Ludovic Courtès <[email-masked]>
Date: Tue, 14 Nov 2017 17:25:14 +0100

* guix/gexp.scm (lower-object): Iterate if LOWERED is a struct.
(lower+expand-object): New procedure.
(gexp->sexp): Use it.
(define-gexp-compiler): Adjust docstring.
---
 guix/gexp.scm | 54 +++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 39 insertions(+), 15 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index b9525603e..c2d942c7f 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -195,24 +195,50 @@ procedure to expand it; otherwise return #f."
 corresponding to OBJ for SYSTEM, cross-compiling for TARGET if TARGET is true.
 OBJ must be an object that has an associated gexp compiler, such as a
 <package>."
-  (match (lookup-compiler obj)
-    (#f
-     (raise (condition (&gexp-input-error (input obj)))))
-    (lower
-     (lower obj system target))))
+  (let loop ((obj obj))
+    (match (lookup-compiler obj)
+      (#f
+       (raise (condition (&gexp-input-error (input obj)))))
+      (lower
+       (mlet %store-monad ((lowered (lower obj system target)))
+         (if (and (struct? lowered) (not (eq? lowered obj)))
+             (loop lowered)
+             (return lowered)))))))
+
+(define* (lower+expand-object obj
+                              #:optional (system (%current-system))
+                              #:key target (output "out"))
+  "Return as a value in %STORE-MONAD the output of object OBJ expands to for
+SYSTEM and TARGET.  Object such as <package>, <file-append>, or <plain-file>
+expand to file names, but it's possible to expand to a plain data type."
+  (let loop ((obj obj)
+             (expand (and (struct? obj) (lookup-expander obj))))
+    (match (lookup-compiler obj)
+      (#f
+       (raise (condition (&gexp-input-error (input obj)))))
+      (lower
+       (mlet %store-monad ((lowered (lower obj system target)))
+         ;; LOWER might return something that needs to be further lowered.
+         (if (struct? lowered)
+             ;; If we lack an expander, delegate to that of LOWERED.
+             (if (not expand)
+                 (loop lowered (lookup-expander lowered))
+                 (return (expand obj lowered output)))
+             (return lowered)))))))               ;lists, vectors, etc.
 
 (define-syntax define-gexp-compiler
   (syntax-rules (=> compiler expander)
     "Define NAME as a compiler for objects matching PREDICATE encountered in
 gexps.
 
-In the simplest form of the macro, BODY must return a derivation for PARAM, an
-object that matches PREDICATE, for SYSTEM and TARGET (the latter of which is
-#f except when cross-compiling.)
+In the simplest form of the macro, BODY must return (1) a derivation for
+a record of the specified type, for SYSTEM and TARGET (the latter of which is
+#f except when cross-compiling), (2) another record that can itself be
+compiled down to a derivation, or (3) an object of a primitive data type.
 
 The more elaborate form allows you to specify an expander:
 
-  (define-gexp-compiler something something?
+  (define-gexp-compiler something-compiler <something>
     compiler => (lambda (param system target) ...)
     expander => (lambda (param drv output) ...))
 
@@ -795,12 +821,10 @@ and in the current monad setting (system type, etc.)"
                            (or n? native?)))
                         refs)))
         (($ <gexp-input> (? struct? thing) output n?)
-         (let ((target (if (or n? native?) #f target))
-               (expand (lookup-expander thing)))
-           (mlet %store-monad ((obj (lower-object thing system
-                                                  #:target target)))
-             ;; OBJ must be either a derivation or a store file name.
-             (return (expand thing obj output)))))
+         (let ((target (if (or n? native?) #f target)))
+           (lower+expand-object thing system
+                                #:target target
+                                #:output output)))
         (($ <gexp-input> x)
          (return x))
         (x
-- 
2.15.0