13/29: gexp: Optimize 'with-build-variables'.

[guix-commits]

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

commit 82839f2d5bf8f322f21f8e2f30084f4c33b4f51e
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Feb 28 18:22:11 2021 +0100

    gexp: Optimize 'with-build-variables'.
    
    * guix/gexp.scm (input-tuples->gexp, outputs->gexp): New procedures.
    (with-build-variables): Use it.
---
 guix/gexp.scm | 50 +++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 41 insertions(+), 9 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index c7fabfe..98f7302 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1786,6 +1786,43 @@ are searched for in PATH.  Return #f when MODULES and 
EXTENSIONS are empty."
                                          extensions))
                               %load-compiled-path)))))))))
 
+(define* (input-tuples->gexp inputs #:key native?)
+  "Given INPUTS, a list of label/gexp-input tuples, return a gexp that expands
+to an input alist."
+  (define references
+    (map (match-lambda
+           ((label input) input))
+         inputs))
+
+  (define labels
+    (match inputs
+      (((labels . _) ...)
+       labels)))
+
+  (define (proc . args)
+    (cons 'quote (list (map cons labels args))))
+
+  ;; This gexp is more efficient than an equivalent hand-written gexp: fewer
+  ;; allocations, no need to scan long list-valued <gexp-input> records in
+  ;; search of file-like objects, etc.
+  (make-gexp references '() '() proc
+             (source-properties inputs)))
+
+(define (outputs->gexp outputs)
+  "Given OUTPUTS, a list of output names, return a gexp that expands to an
+output alist."
+  (define references
+    (map gexp-output outputs))
+
+  (define (proc . args)
+    `(list ,@(map (lambda (name)
+                    `(cons ,name ((@ (guile) getenv) ,name)))
+                  outputs)))
+
+  ;; This gexp is more efficient than an equivalent hand-written gexp.
+  (make-gexp references '() '() proc
+             (source-properties outputs)))
+
 (define (with-build-variables inputs outputs body)
   "Return a gexp that surrounds BODY with a definition of the legacy
 '%build-inputs', '%outputs', and '%output' variables based on INPUTS, a list
@@ -1797,17 +1834,12 @@ of name/gexp-input tuples, and OUTPUTS, a list of 
strings."
   ;; expected.
   (gexp (begin
           (define %build-inputs
-            (map (lambda (tuple)
-                   (apply cons tuple))
-                 '(ungexp inputs)))
+            (ungexp (input-tuples->gexp inputs)))
           (define %outputs
-            (list (ungexp-splicing
-                   (map (lambda (name)
-                          (gexp (cons (ungexp name)
-                                      (ungexp output name))))
-                        outputs))))
-          (define  %output
+            (ungexp (outputs->gexp outputs)))
+          (define %output
             (assoc-ref %outputs "out"))
+
           (ungexp body))))
 
 (define* (gexp->script name exp