gexp: 'gexp-inputs' returns both native and non-native inputs.

This avoids double traversal of references and extra bookkeeping,
thereby further reducing memory allocations.

* guix/gexp.scm (lower-gexp): Include only one call to 'lower-inputs'.
(gexp-inputs): Remove #:native? parameter.
[set-gexp-input-native?]: New procedure.
[add-reference-inputs]: Use it.
(gexp-native-inputs): Remove.
* tests/gexp.scm (gexp-native-inputs): Remove.
(gexp-input->tuple): Include 'gexp-input-native?'.
("let-system")
("let-system, nested")
("ungexp + ungexp-native")
("ungexp + ungexp-native, nested")
("ungexp + ungexp-native, nested, special mixture")
("input list")
("input list + ungexp-native")
("input list splicing")
("input list splicing + ungexp-native-splicing")
("gexp list splicing + ungexp-splicing"): Adjust accordingly.

1 files changed, 21 insertions, 33 deletions

diff --git a/tests/gexp.scm b/tests/gexp.scm
index f742c5db76..0bd1237316 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -51,8 +51,6 @@
 ;; For white-box testing.
 (define (gexp-inputs x)
   ((@@ (guix gexp) gexp-inputs) x))
-(define (gexp-native-inputs x)
-  ((@@ (guix gexp) gexp-native-inputs) x))
 (define (gexp-outputs x)
   ((@@ (guix gexp) gexp-outputs) x))
 (define (gexp->sexp . x)
@@ -64,7 +62,8 @@
                   #:guile-for-build (%guile-for-build)))
 
 (define (gexp-input->tuple input)
-  (list (gexp-input-thing input) (gexp-input-output input)))
+  (list (gexp-input-thing input) (gexp-input-output input)
+        (gexp-input-native? input)))
 
 (define %extension-package
   ;; Example of a package to use when testing 'with-extensions'.
@@ -347,7 +346,7 @@
                  (string-append (derivation->output-path drv)
                                 "/bin/touch"))))))
 (test-equal "let-system"
-  (list `(begin ,(%current-system) #t) '(system-binding) '()
+  (list `(begin ,(%current-system) #t) '(system-binding)
         'low '() '())
   (let* ((exp #~(begin
                   #$(let-system system system)
@@ -361,7 +360,6 @@
                   (string=? (gexp-input-output input) "out")
                   '(system-binding)))
             (x x))
-          (gexp-native-inputs exp)
           'low
           (lowered-gexp-inputs low)
           (lowered-gexp-sources low))))
@@ -383,7 +381,6 @@
 (test-equal "let-system, nested"
   (list `(system* ,(string-append "qemu-system-" (%current-system))
                   "-m" "256")
-        '()
         '(system-binding))
   (let ((exp #~(system*
                 #+(let-system (system target)
@@ -398,12 +395,12 @@
                              (basename command))
                        ,@rest))
             (x x))
-          (gexp-inputs exp)
-          (match (gexp-native-inputs exp)
+          (match (gexp-inputs exp)
             ((input)
              (and (eq? (struct-vtable (gexp-input-thing input))
                        (@@ (guix gexp) <system-binding>))
                   (string=? (gexp-input-output input) "out")
+                  (gexp-input-native? input)
                   '(system-binding)))
             (x x)))))
 
@@ -422,31 +419,26 @@
          (bu     (derivation->output-path
                   (package-cross-derivation %store binutils target))))
     (and (lset= equal?
-                `((,%bootstrap-guile "out") (,glibc "out"))
-                (map gexp-input->tuple (gexp-native-inputs exp)))
-         (lset= equal?
-                `((,coreutils "out") (,binutils "out"))
+                `((,%bootstrap-guile "out" #t)
+                  (,coreutils "out" #f)
+                  (,glibc "out" #t)
+                  (,binutils "out" #f))
                 (map gexp-input->tuple (gexp-inputs exp)))
          (equal? `(list ,guile ,cu ,libc ,bu)
                  (gexp->sexp* exp target)))))
 
 (test-equal "ungexp + ungexp-native, nested"
-  (list `((,%bootstrap-guile "out")) '<> `((,coreutils "out")))
+  `((,%bootstrap-guile "out" #f) (,coreutils "out" #t))
   (let* ((exp (gexp (list (ungexp-native (gexp (ungexp coreutils)))
                           (ungexp %bootstrap-guile)))))
-    (list (map gexp-input->tuple (gexp-inputs exp))
-          '<>
-          (map gexp-input->tuple (gexp-native-inputs exp)))))
+    (map gexp-input->tuple (gexp-inputs exp))))
 
 (test-equal "ungexp + ungexp-native, nested, special mixture"
-  `(() <> ((,coreutils "out")))
+  `((,coreutils "out" #t))
 
-  ;; (gexp-native-inputs exp) used to return '(), wrongfully.
   (let* ((foo (gexp (foo (ungexp-native coreutils))))
          (exp (gexp (bar (ungexp foo)))))
-    (list (map gexp-input->tuple (gexp-inputs exp))
-          '<>
-          (map gexp-input->tuple (gexp-native-inputs exp)))))
+    (map gexp-input->tuple (gexp-inputs exp))))
 
 (test-assert "input list"
   (let ((exp   (gexp (display
@@ -456,7 +448,7 @@
         (cu    (derivation->output-path
                 (package-derivation %store coreutils))))
     (and (lset= equal?
-                `((,%bootstrap-guile "out") (,coreutils "out"))
+                `((,%bootstrap-guile "out" #f) (,coreutils "out" #f))
                 (map gexp-input->tuple (gexp-inputs exp)))
          (equal? `(display '(,guile ,cu))
                  (gexp->sexp* exp)))))
@@ -475,10 +467,8 @@
          (xbu   (derivation->output-path
                  (package-cross-derivation %store binutils target))))
     (and (lset= equal?
-                `((,%bootstrap-guile "out") (,coreutils "out"))
-                (map gexp-input->tuple (gexp-native-inputs exp)))
-         (lset= equal?
-                `((,glibc "out") (,binutils "out"))
+                `((,%bootstrap-guile "out" #t) (,coreutils "out" #t)
+                  (,glibc "out" #f) (,binutils "out" #f))
                 (map gexp-input->tuple (gexp-inputs exp)))
          (equal? `(display (cons '(,guile ,cu) '(,xlibc ,xbu)))
                  (gexp->sexp* exp target)))))
@@ -492,7 +482,7 @@
                          (package-derivation %store %bootstrap-guile))))
          (exp     (gexp (list (ungexp-splicing (cons (+ 2 3) inputs))))))
     (and (lset= equal?
-                `((,glibc "debug") (,%bootstrap-guile "out"))
+                `((,glibc "debug" #f) (,%bootstrap-guile "out" #f))
                 (map gexp-input->tuple (gexp-inputs exp)))
          (equal? (gexp->sexp* exp)
                  `(list ,@(cons 5 outputs))))))
@@ -502,18 +492,16 @@
                        %bootstrap-guile))
          (exp    (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
     (and (lset= equal?
-                `((,glibc "debug") (,%bootstrap-guile "out"))
-                (map gexp-input->tuple (gexp-native-inputs exp)))
-         (null? (gexp-inputs exp))
+                `((,glibc "debug" #t) (,%bootstrap-guile "out" #t))
+                (map gexp-input->tuple (gexp-inputs exp)))
          (equal? (gexp->sexp* exp)                ;native
                  (gexp->sexp* exp "mips64el-linux")))))
 
 (test-assert "gexp list splicing + ungexp-splicing"
   (let* ((inner (gexp (ungexp-native glibc)))
          (exp   (gexp (list (ungexp-splicing (list inner))))))
-    (and (equal? `((,glibc "out"))
-                 (map gexp-input->tuple (gexp-native-inputs exp)))
-         (null? (gexp-inputs exp))
+    (and (equal? `((,glibc "out" #t))
+                 (map gexp-input->tuple (gexp-inputs exp)))
          (equal? (gexp->sexp* exp)                ;native
                  (gexp->sexp* exp "mips64el-linux")))))