32/104: gexp: Compilers can now return lowerable objects.

[guix-commits]

nckx pushed a commit to branch core-updates
in repository guix.

commit 56eafb812fd5cc4168479436a9e04b13d30eb77a
Author: Ludovic Courtès <address@hidden>
AuthorDate: Tue Nov 14 17:10:17 2017 +0100

    gexp: Compilers can now return lowerable objects.
    
    * 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 | 74 ++++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 51 insertions(+), 23 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 6297346..da21057 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -226,32 +226,62 @@ 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
-     ;; Cache in STORE the result of lowering OBJ.
-     (mlet %store-monad ((target (if (eq? target 'current)
-                                     (current-target-system)
-                                     (return target)))
-                         (graft? (grafting?)))
-       (mcached (let ((lower (lookup-compiler obj)))
-                  (lower obj system target))
-                obj
-                system target graft?)))))
+  (mlet %store-monad ((target (if (eq? target 'current)
+                                  (current-target-system)
+                                  (return target)))
+                      (graft? (grafting?)))
+    (let loop ((obj obj))
+      (match (lookup-compiler obj)
+        (#f
+         (raise (condition (&gexp-input-error (input obj)))))
+        (lower
+         ;; Cache in STORE the result of lowering OBJ.
+         (mcached (mlet %store-monad ((lowered (lower obj system target)))
+                    (if (and (struct? lowered)
+                             (not (derivation? lowered)))
+                        (loop lowered)
+                        (return lowered)))
+                  obj
+                  system target graft?))))))
+
+(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 ((graft?  (grafting?))
+                            (lowered (mcached (lower obj system target)
+                                              obj
+                                              system target graft?)))
+         ;; 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)))))))               ;self-quoting
 
 (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) ...))
 
@@ -1148,12 +1178,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> (? self-quoting? x))
          (return x))
         (($ <gexp-input> x)