Merge branch 'master' into staging

4 files changed, 81 insertions, 93 deletions

diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm
index 247a687d80..31fc493b09 100644
--- a/guix/build/bournish.scm
+++ b/guix/build/bournish.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;;
@@ -83,7 +83,21 @@ TERMINAL-WIDTH.  Use COLUMN-GAP spaces between two subsequent columns."
       (newline)
       (loop (map 1+ indexes)))))
 
-(define ls-command-implementation
+(define-syntax define-command-runtime
+  (syntax-rules ()
+    "Define run-time support of a Bournish command.  This macro ensures that
+the implementation is not subject to inlining, which would prevent compiled
+code from referring to it via '@@'."
+    ((_ (command . args) body ...)
+     (define-command-runtime command (lambda args body ...)))
+    ((_ command exp)
+     (begin
+       (define command exp)
+
+       ;; Prevent inlining of COMMAND.
+       (set! command command)))))
+
+(define-command-runtime ls-command-implementation
   ;; Run-time support procedure.
   (case-lambda
     (()
@@ -173,13 +187,13 @@ TERMINAL-WIDTH.  Use COLUMN-GAP spaces between two subsequent columns."
                 (call-with-input-file file lines+chars)))
               (format #t "~a ~a~%" chars file)))
 
-(define (wc-command-implementation . files)
+(define-command-runtime (wc-command-implementation . files)
   (for-each wc-print (filter file-exists?* files)))
 
-(define (wc-l-command-implementation . files)
+(define-command-runtime (wc-l-command-implementation . files)
   (for-each wc-l-print (filter file-exists?* files)))
 
-(define (wc-c-command-implementation . files)
+(define-command-runtime (wc-c-command-implementation . files)
   (for-each wc-c-print (filter file-exists?* files)))
 
 (define (wc-command . args)
diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index 4b6472784c..c4dbb6e34c 100644
--- a/guix/build/compile.scm
+++ b/guix/build/compile.scm
@@ -184,36 +184,36 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
     ;; Exit as soon as something goes wrong.
     (exit-on-exception
      file
-     (with-target host
-       (lambda ()
-         (let ((relative (relative-file source-directory file)))
-           (compile-file file
-                         #:output-file (string-append build-directory "/"
-                                                      (scm->go relative))
-                         #:opts (append warning-options
-                                        (optimization-options relative))))))))
+     (let ((relative (relative-file source-directory file)))
+       (compile-file file
+                     #:output-file (string-append build-directory "/"
+                                                  (scm->go relative))
+                     #:opts (append warning-options
+                                    (optimization-options relative))))))
 
   (with-augmented-search-path %load-path source-directory
     (with-augmented-search-path %load-compiled-path build-directory
       (with-fluids ((*current-warning-prefix* ""))
-
-        ;; FIXME: To work around <https://bugs.gnu.org/15602>, we first load all
-        ;; of FILES.
-        (load-files source-directory files
-                    #:report-load report-load
-                    #:debug-port debug-port)
-
-        ;; Make sure compilation related modules are loaded before starting to
-        ;; compile files in parallel.
+        ;; Make sure the compiler's modules are loaded before 'with-target'
+        ;; (since 'with-target' influences the .go loader), and before
+        ;; starting to compile files in parallel.
         (compile #f)
 
-        ;; XXX: Don't use too many workers to work around the insane memory
-        ;; requirements of the compiler in Guile 2.2.2:
-        ;; <https://lists.gnu.org/archive/html/guile-devel/2017-05/msg00033.html>.
-        (n-par-for-each (min workers 8) build files)
-
-        (unless (zero? total)
-          (report-compilation #f total total))))))
+        (with-target host
+          (lambda ()
+            ;; FIXME: To work around <https://bugs.gnu.org/15602>, we first
+            ;; load all of FILES.
+            (load-files source-directory files
+                        #:report-load report-load
+                        #:debug-port debug-port)
+
+            ;; XXX: Don't use too many workers to work around the insane
+            ;; memory requirements of the compiler in Guile 2.2.2:
+            ;; <https://lists.gnu.org/archive/html/guile-devel/2017-05/msg00033.html>.
+            (n-par-for-each (min workers 8) build files)
+
+            (unless (zero? total)
+              (report-compilation #f total total))))))))
 
 (eval-when (eval load)
   (when (and (string=? "2" (major-version))
diff --git a/guix/build/julia-build-system.scm b/guix/build/julia-build-system.scm
index ff6fcf5fe3..e8ebcf8ba0 100644
--- a/guix/build/julia-build-system.scm
+++ b/guix/build/julia-build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz>
+;;; Copyright © 2019, 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,53 +37,46 @@
 ;; subpath where we store the package content
 (define %package-path "/share/julia/packages/")
 
-(define (generate-load-path inputs outputs)
-  (string-append
-   (string-join (map (match-lambda
-                       ((_ . path)
-                        (string-append path %package-path)))
-                     ;; Restrict to inputs beginning with "julia-".
-                     (filter (match-lambda
-                               ((name . _)
-                                (string-prefix? "julia-" name)))
-                             inputs))
-                ":")
-   (string-append ":" (assoc-ref outputs "out") %package-path)
-   ;; stdlib is always required to find Julia's standard libraries.
-   ;; usually there are other two paths in this variable:
-   ;; "@" and "@v#.#"
-   ":@stdlib"))
-
 (define* (install #:key source inputs outputs #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
          (package-dir (string-append out %package-path
-                                     (string-append
-                                      (strip-store-file-name source)))))
-    (setenv "JULIA_LOAD_PATH" (generate-load-path inputs outputs))
+                                     (strip-store-file-name source))))
     (mkdir-p package-dir)
-    (copy-recursively source package-dir))
+    (copy-recursively (getcwd) package-dir))
   #t)
 
-;; TODO: Precompilation is working, but I don't know how to tell
-;; julia to use use it. If (on rantime) we set HOME to
-;; store path, julia tries to write files there (failing)
 (define* (precompile #:key source inputs outputs #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
          (builddir (string-append out "/share/julia/"))
          (package (strip-store-file-name source)))
     (mkdir-p builddir)
+    ;; With a patch, SOURCE_DATE_EPOCH is honored
+    (setenv "SOURCE_DATE_EPOCH" "1")
     (setenv "JULIA_DEPOT_PATH" builddir)
-    (setenv "JULIA_LOAD_PATH" (generate-load-path inputs outputs))
-    ;; Actual precompilation
-    (invoke-julia (string-append "using " package)))
+    ;; Add new package dir to the load path.
+    (setenv "JULIA_LOAD_PATH"
+            (string-append builddir "packages/" ":"
+                           (or (getenv "JULIA_LOAD_PATH")
+                               "")))
+    ;; Actual precompilation:
+    (invoke-julia
+     ;; When using Julia as a user, Julia writes precompile cache to the first
+     ;; entry of the DEPOT_PATH list (by default, the home dir).  We want to
+     ;; write it to the store, so let's push the store path as the first
+     ;; element of DEPOT_PATH.  Once the cache file exists, this hack is not
+     ;; needed anymore (like in the check phase).  If the user install new
+     ;; packages, those will be installed and precompiled in the home dir.
+     (string-append "pushfirst!(DEPOT_PATH, pop!(DEPOT_PATH)); using " package)))
   #t)
 
 (define* (check #:key source inputs outputs #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
          (package (strip-store-file-name source))
          (builddir (string-append out "/share/julia/")))
+    ;; With a patch, SOURCE_DATE_EPOCH is honored
+    (setenv "SOURCE_DATE_EPOCH" "1")
     (setenv "JULIA_DEPOT_PATH" builddir)
-    (setenv "JULIA_LOAD_PATH" (generate-load-path inputs outputs))
+    (setenv "JULIA_LOAD_PATH" (string-append builddir "packages/"))
     (invoke-julia (string-append "using Pkg;Pkg.test(\"" package "\")")))
   #t)
 
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 0938ec0ff1..73b439fb7d 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,7 +23,6 @@
 
 (define-module (guix build syscalls)
   #:use-module (system foreign)
-  #:use-module (system base target)             ;for cross-compilation support
   #:use-module (rnrs bytevectors)
   #:autoload   (ice-9 binary-ports) (get-bytevector-n)
   #:use-module (srfi srfi-1)
@@ -892,36 +892,6 @@ system to PUT-OLD."
   (namelen uint8)
   (name    uint8))
 
-(define-syntax define-generic-identifier
-  (syntax-rules (gnu/linux gnu/hurd =>)
-    "Define a generic identifier that adjust to the current GNU variant."
-    ((_ id (gnu/linux => linux) (gnu/hurd => hurd))
-     (define-syntax id
-       (lambda (s)
-         (syntax-case s ()
-           ((_ args (... ...))
-            (if (string-contains (or (target-type) %host-type)
-                                 "linux")
-                #'(linux args (... ...))
-                #'(hurd args (... ...))))
-           (_
-            (if (string-contains (or (target-type) %host-type)
-                                 "linux")
-                #'linux
-                #'hurd))))))))
-
-(define-generic-identifier read-dirent-header
-  (gnu/linux => read-dirent-header/linux)
-  (gnu/hurd  => read-dirent-header/hurd))
-
-(define-generic-identifier %struct-dirent-header
-  (gnu/linux => %struct-dirent-header/linux)
-  (gnu/hurd  => %struct-dirent-header/hurd))
-
-(define-generic-identifier sizeof-dirent-header
-  (gnu/linux => sizeof-dirent-header/linux)
-  (gnu/hurd  => sizeof-dirent-header/hurd))
-
 ;; Constants for the 'type' field, from <dirent.h>.
 (define DT_UNKNOWN 0)
 (define DT_FIFO 1)
@@ -960,19 +930,30 @@ system to PUT-OLD."
                  "closedir: ~A" (list (strerror err))
                  (list err)))))))
 
-(define readdir*
+(define (readdir-procedure name-field-offset sizeof-dirent-header
+                           read-dirent-header)
   (let ((proc (syscall->procedure '* "readdir64" '(*))))
     (lambda* (directory #:optional (pointer->string pointer->string/utf-8))
       (let ((ptr (proc directory)))
         (and (not (null-pointer? ptr))
              (cons (pointer->string
-                    (make-pointer (+ (pointer-address ptr)
-                                     (c-struct-field-offset
-                                      %struct-dirent-header name)))
+                    (make-pointer (+ (pointer-address ptr) name-field-offset))
                     -1)
                    (read-dirent-header
                     (pointer->bytevector ptr sizeof-dirent-header))))))))
 
+(define readdir*
+  ;; Decide at run time which one must be used.
+  (if (string-contains %host-type "linux-gnu")
+      (readdir-procedure (c-struct-field-offset %struct-dirent-header/linux
+                                                name)
+                         sizeof-dirent-header/linux
+                         read-dirent-header/linux)
+      (readdir-procedure (c-struct-field-offset %struct-dirent-header/hurd
+                                                name)
+                         sizeof-dirent-header/hurd
+                         read-dirent-header/hurd)))
+
 (define* (scandir* name #:optional
                    (select? (const #t))
                    (entry<? (lambda (entry1 entry2)