08/08: DRAFT gexp: Handle list conversion to <gexp-input> in the expanded code.

[Ludovic Courtès]

civodul pushed a commit to branch wip-build-systems-gexp
in repository guix.

commit 640a79877fcc85f086d278a11f666404c29fbb6f
Author: Ludovic Courtès <address@hidden>
Date:   Fri May 13 15:39:02 2016 +0200

    DRAFT gexp: Handle list conversion to <gexp-input> in the expanded code.
    
    This reduces the number of recursive calls to 'add-reference-inputs' and
    'add-reference-output' when 'gexp-inputs' and 'gexp-outputs' is called.
    
    * guix/gexp.scm (gexp-inputs)[add-reference-inputs]: Don't iterate on
    the list.
    (gexp-outputs)[add-reference-output]: Likewise.
    (gexp->sexp)[reference->sexp]: Likewise.
    (ensure-input-list): New procedure.
    (gexp)[escape->ref]: Have the emitted code use it.
    (imported-files)[build]: Use 'ungexp-native-splicing' instead of
    'ungexp-native'.
    (with-build-variables): Likewise.
    * tests/gexp.scm ("input list", "input list + ungexp-native"):
    Explicitly use 'gexp-input'.
    * guix/packages.scm (patch-and-repack)[build]: For PATCHES, use
    ungexp-native-splicing instead of ungexp-native.
---
 guix/gexp.scm     |   49 +++++++++++++++++++++++--------------------------
 guix/packages.scm |    2 +-
 tests/gexp.scm    |   10 +++++++---
 3 files changed, 31 insertions(+), 30 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 396c38f..9cdef2f 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -639,13 +639,7 @@ references; otherwise, return only non-native references."
            (cons `(,thing ,output) result)
            result))
       (($ <gexp-input> (lst ...) output n?)
-       (fold-right add-reference-inputs result
-                   ;; XXX: For now, automatically convert LST to a list of
-                   ;; gexp-inputs.
-                   (map (match-lambda
-                         ((? gexp-input? x) x)
-                         (x (%gexp-input x "out" (or n? native?))))
-                        lst)))
+       (fold-right add-reference-inputs result lst))
       (_
        ;; Ignore references to other kinds of objects.
        result)))
@@ -668,12 +662,7 @@ references; otherwise, return only non-native references."
       (($ <gexp-input> (? gexp? exp))
        (append (gexp-outputs exp) result))
       (($ <gexp-input> (lst ...) output native?)
-       ;; XXX: Automatically convert LST.
-       (add-reference-output (map (match-lambda
-                                   ((? gexp-input? x) x)
-                                   (x (%gexp-input x "out" native?)))
-                                  lst)
-                             result))
+       (add-reference-output lst result))
       ((lst ...)
        (fold-right add-reference-output result lst))
       (_
@@ -702,12 +691,7 @@ and in the current monad setting (system type, etc.)"
         (($ <gexp-input> (refs ...) output n?)
          (sequence %store-monad
                    (map (lambda (ref)
-                          ;; XXX: Automatically convert REF to an gexp-input.
-                          (reference->sexp
-                           (if (gexp-input? ref)
-                               ref
-                               (%gexp-input ref "out" n?))
-                           native?))
+                          (reference->sexp ref native?))
                         refs)))
         (($ <gexp-input> (? struct? thing) output n?)
          (let ((target (if (or n? native?) #f target)))
@@ -744,6 +728,17 @@ and in the current monad setting (system type, etc.)"
               (simple-format #f "~a:~a" line column)))
         "<unknown location>")))
 
+(define (ensure-input-list lst native?)
+  "Make sure LST is a list of <gexp-input> objects.  If LST is not a list (for
+instance, it could be a gexp), return it."
+  (if (pair? lst)
+      (map (lambda (x)
+             (if (gexp-input? x)
+                 x
+                 (%gexp-input x "out" native?)))
+           lst)
+      lst))
+
 (define-syntax gexp
   (lambda (s)
     (define (collect-escapes exp)
@@ -797,8 +792,8 @@ and in the current monad setting (system type, etc.)"
     (define (escape->ref exp)
       ;; Turn 'ungexp' form EXP into a "reference".
       (syntax-case exp (ungexp ungexp-splicing
-                        ungexp-native ungexp-native-splicing
-                        output)
+                               ungexp-native ungexp-native-splicing
+                               output)
         ((ungexp output)
          #'(gexp-output "out"))
         ((ungexp output name)
@@ -808,13 +803,15 @@ and in the current monad setting (system type, etc.)"
         ((ungexp drv-or-pkg out)
          #'(%gexp-input drv-or-pkg out #f))
         ((ungexp-splicing lst)
-         #'(%gexp-input lst "out" #f))
+         #'(%gexp-input (ensure-input-list lst #f)
+                        "out" #f))
         ((ungexp-native thing)
          #'(%gexp-input thing "out" #t))
         ((ungexp-native drv-or-pkg out)
          #'(%gexp-input drv-or-pkg out #t))
         ((ungexp-native-splicing lst)
-         #'(%gexp-input lst "out" #t))))
+         #'(%gexp-input (ensure-input-list lst #t)
+                        "out" #t))))
 
     (define (substitute-ungexp exp substs)
       ;; Given EXP, an 'ungexp' or 'ungexp-native' form, substitute it with
@@ -842,7 +839,7 @@ and in the current monad setting (system type, etc.)"
       ;; Return a variant of EXP where all the cars of SUBSTS have been
       ;; replaced by the corresponding cdr.
       (syntax-case exp (ungexp ungexp-native
-                        ungexp-splicing ungexp-native-splicing)
+                               ungexp-splicing ungexp-native-splicing)
         ((ungexp _ ...)
          (substitute-ungexp exp substs))
         ((ungexp-native _ ...)
@@ -907,7 +904,7 @@ system, imported, and appears under FINAL-PATH in the 
resulting store path."
                     ((final-path store-path)
                      (mkdir-p (dirname final-path))
                      (symlink store-path final-path)))
-                   '(ungexp files)))))
+                   '((ungexp-native-splicing files))))))
 
     ;; TODO: Pass FILES as an environment variable so that BUILD remains
     ;; exactly the same regardless of FILES: less disk space, and fewer
@@ -1014,7 +1011,7 @@ of name/gexp-input tuples, and OUTPUTS, a list of 
strings."
           (define %build-inputs
             (map (lambda (tuple)
                    (apply cons tuple))
-                 '(ungexp inputs)))
+                 '((ungexp-splicing inputs))))
           (define %outputs
             (list (ungexp-splicing
                    (map (lambda (name)
diff --git a/guix/packages.scm b/guix/packages.scm
index df1054c..8c61aa6 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -508,7 +508,7 @@ IMPORTED-MODULES specify modules to use/import for use by 
SNIPPET."
                          "source is under '~a'~%" directory)
                  (chdir directory)
 
-                 (and (every apply-patch '#+patches)
+                 (and (every apply-patch '(address@hidden))
                       #+@(if snippet
                              #~((let ((module (make-fresh-user-module)))
                                   (module-use-interfaces! module
diff --git a/tests/gexp.scm b/tests/gexp.scm
index edce075..9b9a31c 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -208,7 +208,8 @@
 
 (test-assert "input list"
   (let ((exp   (gexp (display
-                      '(ungexp (list %bootstrap-guile coreutils)))))
+                      '(ungexp (list (gexp-input %bootstrap-guile)
+                                     (gexp-input coreutils))))))
         (guile (derivation->output-path
                 (package-derivation %store %bootstrap-guile)))
         (cu    (derivation->output-path
@@ -222,8 +223,11 @@
 (test-assert "input list + ungexp-native"
   (let* ((target "mips64el-linux")
          (exp   (gexp (display
-                       (cons '(ungexp-native (list %bootstrap-guile coreutils))
-                             '(ungexp (list glibc binutils))))))
+                       (cons '(ungexp-native (map gexp-input
+                                                  (list %bootstrap-guile
+                                                        coreutils)))
+                             '(ungexp (map gexp-input
+                                           (list glibc binutils)))))))
          (guile (derivation->output-path
                  (package-derivation %store %bootstrap-guile)))
          (cu    (derivation->output-path