Merge branch 'master' into core-updates

12 files changed, 697 insertions, 383 deletions

diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm
index 00a4a46d81..4042630a10 100644
--- a/guix/build/ant-build-system.scm
+++ b/guix/build/ant-build-system.scm
@@ -35,7 +35,8 @@
 ;;
 ;; Code:
 
-(define (default-build.xml jar-name prefix)
+(define* (default-build.xml jar-name prefix #:optional
+                            (source-dir ".") (test-dir "./test"))
   "Create a simple build.xml with standard targets for Ant."
   (call-with-output-file "build.xml"
     (lambda (port)
@@ -47,6 +48,10 @@
                               (value "${basedir}/build/jar")))
                  (property (@ (name "dist.dir")
                               (value ,prefix)))
+                 (property (@ (name "test.home")
+                              (value ,test-dir)))
+                 (property (@ (name "test.classes.dir")
+                              (value "${basedir}/build/test-classes")))
 
                  ;; respect the CLASSPATH environment variable
                  (property (@ (name "build.sysclasspath")
@@ -58,10 +63,39 @@
                  (target (@ (name "compile"))
                          (mkdir (@ (dir "${classes.dir}")))
                          (javac (@ (includeantruntime "false")
-                                   (srcdir "src")
+                                   (srcdir ,source-dir)
                                    (destdir "${classes.dir}")
                                    (classpath (@ (refid "classpath"))))))
 
+                 (target (@ (name "compile-tests"))
+                         (mkdir (@ (dir "${test.classes.dir}")))
+                         (javac (@ (includeantruntime "false")
+                                   (srcdir ,test-dir)
+                                   (destdir "${test.classes.dir}"))
+                                (classpath
+                                 (pathelement (@ (path "${env.CLASSPATH}")))
+                                 (pathelement (@ (location "${classes.dir}")))
+                                 (pathelement (@ (location "${test.classes.dir}"))))))
+
+                 (target (@ (name "check")
+                            (depends "compile-tests"))
+                         (mkdir (@ (dir "${test.home}/test-reports")))
+                         (junit (@ (printsummary "true")
+                                   (showoutput "true")
+                                   (fork "yes")
+                                   (haltonfailure "yes"))
+                                (classpath
+                                 (pathelement (@ (path "${env.CLASSPATH}")))
+                                 (pathelement (@ (location "${test.home}/resources")))
+                                 (pathelement (@ (location "${classes.dir}")))
+                                 (pathelement (@ (location "${test.classes.dir}"))))
+                                (formatter (@ (type "plain")
+                                              (usefile "true")))
+                                (batchtest (@ (fork "yes")
+                                              (todir "${test.home}/test-reports"))
+                                           (fileset (@ (dir "${test.home}/java"))
+                                                    (include (@ (name "**/*Test.java" )))))))
+
                  (target (@ (name "jar")
                             (depends "compile"))
                          (mkdir (@ (dir "${jar.dir}")))
@@ -98,11 +132,13 @@ to the default GNU unpack strategy."
       ((assq-ref gnu:%standard-phases 'unpack) #:source source)))
 
 (define* (configure #:key inputs outputs (jar-name #f)
-                    #:allow-other-keys)
+                    (source-dir "src")
+                    (test-dir "src/test") #:allow-other-keys)
   (when jar-name
     (default-build.xml jar-name
                        (string-append (assoc-ref outputs "out")
-                                      "/share/java")))
+                                      "/share/java")
+                       source-dir test-dir))
   (setenv "JAVA_HOME" (assoc-ref inputs "jdk"))
   (setenv "CLASSPATH" (generate-classpath inputs)))
 
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index 085d073dea..c5e820a00a 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
+;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +21,7 @@
   #:use-module (guix build utils)
   #:use-module (guix build lisp-utils)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 receive)
@@ -42,50 +43,42 @@
 
 (define %object-prefix "/lib")
 
-(define (source-install-prefix lisp)
-  (string-append %install-prefix "/" lisp "-source"))
+(define (%lisp-source-install-prefix)
+  (string-append %source-install-prefix "/" (%lisp-type) "-source"))
 
 (define %system-install-prefix
-  (string-append %install-prefix "/systems"))
+  (string-append %source-install-prefix "/systems"))
 
-(define (output-path->package-name path)
-  (package-name->name+version (strip-store-file-name path)))
-
-(define (outputs->name outputs)
-  (output-path->package-name
-   (assoc-ref outputs "out")))
-
-(define (lisp-source-directory output lisp name)
-  (string-append output (source-install-prefix lisp) "/" name))
+(define (lisp-source-directory output name)
+  (string-append output (%lisp-source-install-prefix) "/" name))
 
 (define (source-directory output name)
-  (string-append output %install-prefix "/source/" name))
+  (string-append output %source-install-prefix "/source/" name))
 
-(define (library-directory output lisp)
+(define (library-directory output)
   (string-append output %object-prefix
-                 "/" lisp))
+                 "/" (%lisp-type)))
 
 (define (output-translation source-path
-                            object-output
-                            lisp)
+                            object-output)
   "Return a translation for the system's source path
 to it's binary output."
   `((,source-path
      :**/ :*.*.*)
-    (,(library-directory object-output lisp)
+    (,(library-directory object-output)
      :**/ :*.*.*)))
 
-(define (source-asd-file output lisp name asd-file)
-  (string-append (lisp-source-directory output lisp name) "/" asd-file))
-
-(define (copy-files-to-output outputs output name)
-  "Copy all files from OUTPUT to \"out\".  Create an extra link to any
-system-defining files in the source to a convenient location.  This is done
-before any compiling so that the compiled source locations will be valid."
-  (let* ((out (assoc-ref outputs output))
-         (source (getcwd))
-         (target (source-directory out name))
-         (system-path (string-append out %system-install-prefix)))
+(define (source-asd-file output name asd-file)
+  (string-append (lisp-source-directory output name) "/" asd-file))
+
+(define (copy-files-to-output out name)
+  "Copy all files from the current directory to OUT.  Create an extra link to
+any system-defining files in the source to a convenient location.  This is
+done before any compiling so that the compiled source locations will be
+valid."
+  (let ((source (getcwd))
+        (target (source-directory out name))
+        (system-path (string-append out %system-install-prefix)))
     (copy-recursively source target)
     (mkdir-p system-path)
     (for-each
@@ -97,45 +90,38 @@ before any compiling so that the compiled source locations will be valid."
 
 (define* (install #:key outputs #:allow-other-keys)
   "Copy and symlink all the source files."
-  (copy-files-to-output outputs "out" (outputs->name outputs)))
-
-(define* (copy-source #:key outputs lisp #:allow-other-keys)
-  "Copy the source to \"out\"."
-  (let* ((out (assoc-ref outputs "out"))
-         (name (remove-lisp-from-name (output-path->package-name out) lisp))
-         (install-path (string-append out %install-prefix)))
-    (copy-files-to-output outputs "out" name)
+  (define output (assoc-ref outputs "out"))
+  (copy-files-to-output output
+                        (package-name->name+version
+                         (strip-store-file-name output))))
+
+(define* (copy-source #:key outputs asd-system-name #:allow-other-keys)
+  "Copy the source to the library output."
+  (let* ((out (library-output outputs))
+         (install-path (string-append out %source-install-prefix)))
+    (copy-files-to-output out asd-system-name)
     ;; Hide the files from asdf
     (with-directory-excursion install-path
-      (rename-file "source" (string-append lisp "-source"))
+      (rename-file "source" (string-append (%lisp-type) "-source"))
       (delete-file-recursively "systems")))
   #t)
 
-(define* (build #:key outputs inputs lisp asd-file
+(define* (build #:key outputs inputs asd-file asd-system-name
                 #:allow-other-keys)
   "Compile the system."
-  (let* ((out (assoc-ref outputs "out"))
-         (name (remove-lisp-from-name (output-path->package-name out) lisp))
-         (source-path (lisp-source-directory out lisp name))
+  (let* ((out (library-output outputs))
+         (source-path (lisp-source-directory out asd-system-name))
          (translations (wrap-output-translations
                         `(,(output-translation source-path
-                                               out
-                                               lisp))))
-         (asd-file (and=> asd-file (cut source-asd-file out lisp name <>))))
+                                               out))))
+         (asd-file (source-asd-file out asd-system-name asd-file)))
 
     (setenv "ASDF_OUTPUT_TRANSLATIONS"
             (replace-escaped-macros (format #f "~S" translations)))
 
-    ;; We don't need this if we have the asd file, and it can mess with the
-    ;; load ordering we're trying to enforce
-    (unless asd-file
-      (prepend-to-source-registry (string-append source-path "//")))
-
     (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache
 
-    (parameterize ((%lisp (string-append
-                           (assoc-ref inputs lisp) "/bin/" lisp)))
-      (compile-system name lisp asd-file))
+    (compile-system asd-system-name asd-file)
 
     ;; As above, ecl will sometimes create this even though it doesn't use it
 
@@ -144,56 +130,48 @@ before any compiling so that the compiled source locations will be valid."
         (delete-file-recursively cache-directory))))
   #t)
 
-(define* (check #:key lisp tests? outputs inputs asd-file
+(define* (check #:key tests? outputs inputs asd-file asd-system-name
+                test-asd-file
                 #:allow-other-keys)
   "Test the system."
-  (let* ((name (remove-lisp-from-name (outputs->name outputs) lisp))
-         (out (assoc-ref outputs "out"))
-         (asd-file (and=> asd-file (cut source-asd-file out lisp name <>))))
+  (let* ((out (library-output outputs))
+         (asd-file (source-asd-file out asd-system-name asd-file))
+         (test-asd-file
+          (and=> test-asd-file
+                 (cut source-asd-file out asd-system-name <>))))
     (if tests?
-        (parameterize ((%lisp (string-append
-                               (assoc-ref inputs lisp) "/bin/" lisp)))
-          (test-system name lisp asd-file))
+        (test-system asd-system-name asd-file test-asd-file)
         (format #t "test suite not run~%")))
   #t)
 
-(define* (patch-asd-files #:key outputs
+(define* (create-asd-file #:key outputs
                           inputs
-                          lisp
-                          special-dependencies
-                          test-only-systems
+                          asd-file
+                          asd-system-name
                           #:allow-other-keys)
-  "Patch any asd files created by the compilation process so that they can
-find their dependencies.  Exclude any TEST-ONLY-SYSTEMS which were only
-included to run tests.  Add any SPECIAL-DEPENDENCIES which the LISP
-implementation itself provides."
-  (let* ((out (assoc-ref outputs "out"))
-         (name (remove-lisp-from-name (output-path->package-name out) lisp))
-         (registry (lset-difference
-                    (lambda (input system)
-                      (match input
-                        ((name . path) (string=? name system))))
-                    (lisp-dependencies lisp inputs)
-                    test-only-systems))
-         (lisp-systems (map first registry)))
-
-    (for-each
-     (lambda (asd-file)
-       (patch-asd-file asd-file registry lisp
-                       (append lisp-systems special-dependencies)))
-     (find-files out "\\.asd$")))
+  "Create a system definition file for the built system."
+  (let*-values (((out) (library-output outputs))
+                ((_ version) (package-name->name+version
+                              (strip-store-file-name out)))
+                ((new-asd-file) (string-append
+                                 (library-directory out)
+                                 "/" (normalize-string asd-system-name)
+                                 ".asd")))
+
+    (make-asd-file new-asd-file
+                   #:system asd-system-name
+                   #:version version
+                   #:inputs inputs
+                   #:system-asd-file asd-file))
   #t)
 
-(define* (symlink-asd-files #:key outputs lisp #:allow-other-keys)
+(define* (symlink-asd-files #:key outputs #:allow-other-keys)
   "Create an extra reference to the system in a convenient location."
-  (let* ((out (assoc-ref outputs "out")))
+  (let* ((out (library-output outputs)))
     (for-each
      (lambda (asd-file)
-       (substitute* asd-file
-         ((";;; Built for.*") "") ; remove potential non-determinism
-         (("^\\(DEFSYSTEM(.*)$" all end) (string-append "(asdf:defsystem" end)))
        (receive (new-asd-file asd-file-directory)
-           (bundle-asd-file out asd-file lisp)
+           (bundle-asd-file out asd-file)
          (mkdir-p asd-file-directory)
          (symlink asd-file new-asd-file)
          ;; Update the source registry for future phases which might want to
@@ -201,15 +179,14 @@ implementation itself provides."
          (prepend-to-source-registry
           (string-append asd-file-directory "/"))))
 
-     (find-files (string-append out %object-prefix) "\\.asd$"))
-)
+     (find-files (string-append out %object-prefix) "\\.asd$")))
   #t)
 
-(define* (cleanup-files #:key outputs lisp
-                             #:allow-other-keys)
+(define* (cleanup-files #:key outputs
+                        #:allow-other-keys)
   "Remove any compiled files which are not a part of the final bundle."
-  (let ((out (assoc-ref outputs "out")))
-    (match lisp
+  (let ((out (library-output outputs)))
+    (match (%lisp-type)
       ("sbcl"
        (for-each
         (lambda (file)
@@ -219,10 +196,9 @@ implementation itself provides."
       ("ecl"
        (for-each delete-file
                  (append (find-files out "\\.fas$")
-                         (find-files out "\\.o$")
-                         (find-files out "\\.a$")))))
+                         (find-files out "\\.o$")))))
 
-    (with-directory-excursion (library-directory out lisp)
+    (with-directory-excursion (library-directory out)
       (for-each
        (lambda (file)
          (rename-file file
@@ -237,9 +213,9 @@ implementation itself provides."
                             (string<> ".." file)))))))
   #t)
 
-(define* (strip #:key lisp #:allow-other-keys #:rest args)
+(define* (strip #:rest args)
   ;; stripping sbcl binaries removes their entry program and extra systems
-  (or (string=? lisp "sbcl")
+  (or (string=? (%lisp-type) "sbcl")
       (apply (assoc-ref gnu:%standard-phases 'strip) args)))
 
 (define %standard-phases/source
@@ -257,8 +233,8 @@ implementation itself provides."
     (add-before 'build 'copy-source copy-source)
     (replace 'check check)
     (replace 'strip strip)
-    (add-after 'check 'link-dependencies patch-asd-files)
-    (add-after 'link-dependencies 'cleanup cleanup-files)
+    (add-after 'check 'create-asd-file create-asd-file)
+    (add-after 'create-asd-file 'cleanup cleanup-files)
     (add-after 'cleanup 'create-symlinks symlink-asd-files)))
 
 (define* (asdf-build #:key inputs
diff --git a/guix/build/bournish.scm b/guix/build/bournish.scm
index e948cd03d3..247a687d80 100644
--- a/guix/build/bournish.scm
+++ b/guix/build/bournish.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;;
@@ -48,11 +48,19 @@ refers to."
       str))
 
 (define* (display-tabulated lst
-                             #:key (columns 3)
-                             (column-width (/ 78 columns)))
-  "Display the list of string LST in COLUMNS columns of COLUMN-WIDTH
-characters."
+                            #:key
+                            (terminal-width 80)
+                            (column-gap 2))
+  "Display the list of string LST in as many columns as needed given
+TERMINAL-WIDTH.  Use COLUMN-GAP spaces between two subsequent columns."
   (define len (length lst))
+  (define column-width
+    ;; The width of a column.  Assume all the columns have the same width
+    ;; (GNU ls is smarter than that.)
+    (+ column-gap (reduce max 0 (map string-length lst))))
+  (define columns
+    (max 1
+         (quotient terminal-width column-width)))
   (define pad
     (if (zero? (modulo len columns))
         0
@@ -81,16 +89,30 @@ characters."
     (()
      (display-tabulated (scandir ".")))
     (files
-     (let ((files (filter (lambda (file)
-                            (catch 'system-error
-                              (lambda ()
-                                (lstat file))
-                              (lambda args
-                                (let ((errno (system-error-errno args)))
-                                  (format (current-error-port) "~a: ~a~%"
-                                          file (strerror errno))
-                                  #f))))
-                          files)))
+     (let ((files (append-map (lambda (file)
+                                (catch 'system-error
+                                  (lambda ()
+                                    (match (stat:type (lstat file))
+                                      ('directory
+                                       ;; Like GNU ls, list the contents of
+                                       ;; FILE rather than FILE itself.
+                                       (match (scandir file
+                                                       (match-lambda
+                                                         ((or "." "..") #f)
+                                                         (_ #t)))
+                                         (#f
+                                          (list file))
+                                         ((files ...)
+                                          (map (cut string-append file "/" <>)
+                                               files))))
+                                      (_
+                                       (list file))))
+                                  (lambda args
+                                    (let ((errno (system-error-errno args)))
+                                      (format (current-error-port) "~a: ~a~%"
+                                              file (strerror errno))
+                                      '()))))
+                              files)))
        (display-tabulated files)))))
 
 (define (ls-command . files)
diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm
index f11d858749..139b40321f 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -116,12 +117,12 @@ directory = '" port)
       (close-pipe port)
       result)))
 
-;; Example dir-name: "/gnu/store/hwlr49riz3la33m6in2n898ly045ylld-rust-rand-0.3.15".
 (define (generate-checksums dir-name src-name)
-  "Given DIR-NAME, checksum all the files in it one by one and put the
-   result into the file \".cargo-checksum.json\" in the same directory.
-   Also includes the checksum of an extra file SRC-NAME as if it was
-   part of the directory DIR-NAME with name \"package\"."
+  "Given DIR-NAME, a store directory, checksum all the files in it one
+by one and put the result into the file \".cargo-checksum.json\" in
+the same directory.  Also includes the checksum of an extra file
+SRC-NAME as if it was part of the directory DIR-NAME with name
+\"package\"."
   (let* ((file-names (find-files dir-name "."))
          (dir-prefix-name (string-append dir-name "/"))
          (dir-prefix-name-len (string-length dir-prefix-name))
diff --git a/guix/build/download.scm b/guix/build/download.scm
index e3d5244590..ce4708a873 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -140,6 +140,13 @@ Otherwise return STORE-PATH."
                        (string-drop base 32)))
       store-path))
 
+(cond-expand
+  (guile-2.2
+   ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and
+   ;; nanoseconds swapped (fixed in Guile commit 886ac3e).  Work around it.
+   (define time-monotonic time-tai))
+  (else #t))
+
 (define* (progress-proc file size
                         #:optional (log-port (current-output-port))
                         #:key (abbreviation basename))
@@ -389,7 +396,21 @@ host name without trailing dot."
     ;;(set-log-level! 10)
     ;;(set-log-procedure! log)
 
-    (handshake session)
+    (catch 'gnutls-error
+      (lambda ()
+        (handshake session))
+      (lambda (key err proc . rest)
+        (cond ((eq? err error/warning-alert-received)
+               ;; Like Wget, do no stop upon non-fatal alerts such as
+               ;; 'alert-description/unrecognized-name'.
+               (format (current-error-port)
+                       "warning: TLS warning alert received: ~a~%"
+                       (alert-description->string (alert-get session)))
+               (handshake session))
+              (else
+               ;; XXX: We'd use 'gnutls_error_is_fatal' but (gnutls) doesn't
+               ;; provide a binding for this.
+               (apply throw key err proc rest)))))
 
     ;; Verify the server's certificate if needed.
     (when verify-certificate?
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index 44e8b0d31e..50af4be363 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -47,10 +47,12 @@
 (define (store-file->elisp-source-file file)
   "Convert FILE, a store file name for an Emacs Lisp source file, into a file
 name that has been stripped of the hash and version number."
-  (let-values (((name version)
-                (package-name->name+version
-                 (strip-store-file-name file))))
-    (string-append name ".el")))
+  (let ((suffix ".el"))
+    (let-values (((name version)
+                  (package-name->name+version
+                   (basename
+                    (strip-store-file-name file) suffix))))
+      (string-append name suffix))))
 
 (define* (unpack #:key source #:allow-other-keys)
   "Unpack SOURCE into the build directory.  SOURCE may be a compressed
@@ -93,14 +95,30 @@ store in '.el' files."
           (substitute-cmd))))
     #t))
 
-(define* (install #:key outputs #:allow-other-keys)
+(define* (install #:key outputs
+                  (include '("^[^/]*\\.el$" "^[^/]*\\.info$" "^doc/.*\\.info$"))
+                  (exclude '("^\\.dir-locals\\.el$" "-pkg\\.el$" "^[^/]*tests?\\.el$"))
+                  #:allow-other-keys)
   "Install the package contents."
+
+  (define source (getcwd))
+
+  (define (install-file? file stat)
+    (let ((stripped-file (string-trim (string-drop file (string-length source)) #\/)))
+      (and (any (cut string-match <> stripped-file) include)
+           (not (any (cut string-match <> stripped-file) exclude)))))
+
   (let* ((out (assoc-ref outputs "out"))
          (elpa-name-ver (store-directory->elpa-name-version out))
-         (src-dir (getcwd))
-         (tgt-dir (string-append out %install-suffix "/" elpa-name-ver)))
-    (copy-recursively src-dir tgt-dir)
-    #t))
+         (target-directory (string-append out %install-suffix "/" elpa-name-ver)))
+    (for-each
+     (lambda (file)
+       (let* ((stripped-file (string-drop file (string-length source)))
+              (target-file (string-append target-directory stripped-file)))
+         (format #t "`~a' -> `~a'~%" file target-file)
+         (install-file file (dirname target-file))))
+     (find-files source install-file?)))
+  #t)
 
 (define* (move-doc #:key outputs #:allow-other-keys)
   "Move info files from the ELPA package directory to the info directory."
diff --git a/guix/build/java-utils.scm b/guix/build/java-utils.scm
new file mode 100644
index 0000000000..402d377bf8
--- /dev/null
+++ b/guix/build/java-utils.scm
@@ -0,0 +1,55 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build java-utils)
+  #:use-module (guix build utils)
+  #:export (ant-build-javadoc
+            install-jars
+            install-javadoc))
+
+;; Copied from haskell-build-system.scm
+(define (package-name-version store-dir)
+  "Given a store directory STORE-DIR return 'name-version' of the package."
+  (let* ((base (basename store-dir)))
+    (string-drop base (+ 1 (string-index base #\-)))))
+
+(define* (ant-build-javadoc #:key (target "javadoc") (make-flags '())
+                            #:allow-other-keys)
+  (zero? (apply system* `("ant" ,target ,@make-flags))))
+
+(define* (install-jars jar-directory)
+  "Install jar files from JAR-DIRECTORY to the default target directory.  This
+is used in case the build.xml does not include an install target."
+  (lambda* (#:key outputs #:allow-other-keys)
+    (let ((share (string-append (assoc-ref outputs "out")
+                                "/share/java")))
+      (for-each (lambda (f) (install-file f share))
+                (find-files jar-directory "\\.jar$"))
+      #t)))
+
+(define* (install-javadoc apidoc-directory)
+  "Install the APIDOC-DIRECTORY to the target directory.  This is used to
+install javadocs when this is not done by the install target."
+  (lambda* (#:key outputs #:allow-other-keys)
+    (let* ((out (assoc-ref outputs "out"))
+           (docs (string-append (or (assoc-ref outputs "doc") out)
+                                "/share/doc/" (package-name-version out) "/")))
+      (mkdir-p docs)
+      (copy-recursively apidoc-directory docs)
+      #t)))
diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index 55a07c7207..21cb620d59 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
+;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,13 +18,15 @@
 
 (define-module (guix build lisp-utils)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 hash-table)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (guix build utils)
   #:export (%lisp
-            %install-prefix
+            %lisp-type
+            %source-install-prefix
             lisp-eval-program
             compile-system
             test-system
@@ -32,15 +34,16 @@
             generate-executable-wrapper-system
             generate-executable-entry-point
             generate-executable-for-system
-            patch-asd-file
-            bundle-install-prefix
-            lisp-dependencies
+            %bundle-install-prefix
             bundle-asd-file
-            remove-lisp-from-name
             wrap-output-translations
             prepend-to-source-registry
             build-program
-            build-image))
+            build-image
+            make-asd-file
+            valid-char-set
+            normalize-string
+            library-output))
 
 ;;; Commentary:
 ;;;
@@ -54,102 +57,164 @@
   ;; File name of the Lisp compiler.
   (make-parameter "lisp"))
 
-(define %install-prefix "/share/common-lisp")
-
-(define (bundle-install-prefix lisp)
-  (string-append %install-prefix "/" lisp "-bundle-systems"))
+(define %lisp-type
+  ;; String representing the class of implementation being used.
+  (make-parameter "lisp"))
 
-(define (remove-lisp-from-name name lisp)
-  (string-drop name (1+ (string-length lisp))))
+;; The common parent for Lisp source files, as will as the symbolic
+;; link farm for system definition (.asd) files.
+(define %source-install-prefix "/share/common-lisp")
+
+(define (%bundle-install-prefix)
+  (string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems"))
+
+(define (library-output outputs)
+  "If a `lib' output exists, build things there. Otherwise use `out'."
+  (or (assoc-ref outputs "lib") (assoc-ref outputs "out")))
+
+;; See nix/libstore/store-api.cc#checkStoreName.
+(define valid-char-set
+  (string->char-set
+   "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?="))
+
+(define (normalize-string str)
+  "Replace invalid characters in STR with a hyphen."
+  (string-join (string-tokenize str valid-char-set) "-"))
+
+(define (inputs->asd-file-map inputs)
+  "Produce a hash table of the form (system . asd-file), where system is the
+name of an ASD system, and asd-file is the full path to its definition."
+  (alist->hash-table
+   (filter-map
+    (match-lambda
+      ((_ . path)
+       (let ((prefix (string-append path (%bundle-install-prefix))))
+         (and (directory-exists? prefix)
+              (match (find-files prefix "\\.asd$")
+                ((asd-file)
+                 (cons
+                  (string-drop-right (basename asd-file) 4) ; drop ".asd"
+                  asd-file))
+                (_ #f))))))
+    inputs)))
 
 (define (wrap-output-translations translations)
   `(:output-translations
     ,@translations
     :inherit-configuration))
 
-(define (lisp-eval-program lisp program)
+(define (lisp-eval-program program)
   "Evaluate PROGRAM with a given LISP implementation."
   (unless (zero? (apply system*
-                        (lisp-invoke lisp (format #f "~S" program))))
-    (error "lisp-eval-program failed!" lisp program)))
-
-(define (lisp-invoke lisp program)
+                        (lisp-invocation program)))
+    (error "lisp-eval-program failed!" (%lisp) program)))
+
+(define (spread-statements program argument-name)
+  "Return a list with the statements from PROGRAM spread between
+ARGUMENT-NAME, a string representing the argument a lisp implementation uses
+to accept statements to be evaluated before starting."
+  (append-map (lambda (statement)
+                (list argument-name (format #f "~S" statement)))
+              program))
+
+(define (lisp-invocation program)
   "Return a list of arguments for system* determining how to invoke LISP
 with PROGRAM."
-  (match lisp
-    ("sbcl" `(,(%lisp) "--non-interactive" "--eval" ,program))
-    ("ecl" `(,(%lisp) "-eval" ,program "-eval" "(quit)"))))
+  (match (%lisp-type)
+    ("sbcl" `(,(%lisp) "--non-interactive"
+              ,@(spread-statements program "--eval")))
+    ("ecl" `(,(%lisp)
+             ,@(spread-statements program "--eval")
+             "--eval" "(quit)"))
+    (_ (error "The LISP provided is not supported at this time."))))
 
 (define (asdf-load-all systems)
   (map (lambda (system)
-         `(funcall
-           (find-symbol
-            (symbol-name :load-system)
-            (symbol-name :asdf))
-           ,system))
+         `(asdf:load-system ,system))
        systems))
 
-(define (compile-system system lisp asd-file)
+(define (compile-system system asd-file)
   "Use a lisp implementation to compile SYSTEM using asdf.  Load ASD-FILE
-first if SYSTEM is defined there."
-  (lisp-eval-program lisp
-                     `(progn
-                       (require :asdf)
-                       (in-package :asdf)
-                       ,@(if asd-file
-                             `((load ,asd-file))
-                             '())
-                       (in-package :cl-user)
-                       (funcall (find-symbol
-                                 (symbol-name :operate)
-                                 (symbol-name :asdf))
-                                (find-symbol
-                                 (symbol-name :compile-bundle-op)
-                                 (symbol-name :asdf))
-                                ,system)
-                       (funcall (find-symbol
-                                 (symbol-name :operate)
-                                 (symbol-name :asdf))
-                                (find-symbol
-                                 (symbol-name :deliver-asd-op)
-                                 (symbol-name :asdf))
-                                ,system))))
-
-(define (test-system system lisp asd-file)
-  "Use a lisp implementation to test SYSTEM using asdf.  Load ASD-FILE first
-if SYSTEM is defined there."
-  (lisp-eval-program lisp
-                     `(progn
-                       (require :asdf)
-                       (in-package :asdf)
-                       ,@(if asd-file
-                             `((load ,asd-file))
-                             '())
-                       (in-package :cl-user)
-                       (funcall (find-symbol
-                                 (symbol-name :test-system)
-                                 (symbol-name :asdf))
-                                ,system))))
+first."
+  (lisp-eval-program
+   `((require :asdf)
+     (let ((*package* (find-package :asdf)))
+       (load ,asd-file))
+     (asdf:operate 'asdf:compile-bundle-op ,system))))
+
+(define (system-dependencies system asd-file)
+  "Return the dependencies of SYSTEM, as reported by
+asdf:system-depends-on.  First load the system's ASD-FILE."
+  (define deps-file ".deps.sexp")
+  (define program
+    `((require :asdf)
+      (let ((*package* (find-package :asdf)))
+        (load ,asd-file))
+      (with-open-file
+       (stream ,deps-file :direction :output)
+       (format stream
+               "~s~%"
+               (asdf:system-depends-on
+                (asdf:find-system ,system))))))
+
+  (dynamic-wind
+    (lambda _
+      (lisp-eval-program program))
+    (lambda _
+      (call-with-input-file deps-file read))
+    (lambda _
+      (when (file-exists? deps-file)
+        (delete-file deps-file)))))
+
+(define (compiled-system system)
+  (let ((system (basename system))) ; this is how asdf handles slashes
+    (match (%lisp-type)
+      ("sbcl" (string-append system "--system"))
+      (_ system))))
+
+(define* (generate-system-definition system
+                                     #:key version dependencies)
+  `(asdf:defsystem
+    ,(normalize-string system)
+    :class asdf/bundle:prebuilt-system
+    :version ,version
+    :depends-on ,dependencies
+    :components ((:compiled-file ,(compiled-system system)))
+    ,@(if (string=? "ecl" (%lisp-type))
+          `(:lib ,(string-append system ".a"))
+          '())))
+
+(define (test-system system asd-file test-asd-file)
+  "Use a lisp implementation to test SYSTEM using asdf.  Load ASD-FILE first.
+Also load TEST-ASD-FILE if necessary."
+  (lisp-eval-program
+   `((require :asdf)
+     (let ((*package* (find-package :asdf)))
+       (load ,asd-file)
+       ,@(if test-asd-file
+             `((load ,test-asd-file))
+             ;; Try some likely files.
+             (map (lambda (file)
+                    `(when (uiop:file-exists-p ,file)
+                       (load ,file)))
+                  (list
+                   (string-append system "-tests.asd")
+                   (string-append system "-test.asd")
+                   "tests.asd"
+                   "test.asd"))))
+     (asdf:test-system ,system))))
 
 (define (string->lisp-keyword . strings)
   "Return a lisp keyword for the concatenation of STRINGS."
   (string->symbol (apply string-append ":" strings)))
 
-(define (generate-executable-for-system type system lisp)
-  "Use LISP to generate an executable, whose TYPE can be \"image\" or
-\"program\".  The latter will always be standalone.  Depends on having created
-a \"SYSTEM-exec\" system which contains the entry program."
+(define (generate-executable-for-system type system)
+  "Use LISP to generate an executable, whose TYPE can be 'asdf:image-op or
+'asdf:program-op.  The latter will always be standalone.  Depends on having
+created a \"SYSTEM-exec\" system which contains the entry program."
   (lisp-eval-program
-   lisp
-   `(progn
-     (require :asdf)
-     (funcall (find-symbol
-               (symbol-name :operate)
-               (symbol-name :asdf))
-              (find-symbol
-               (symbol-name ,(string->lisp-keyword type "-op"))
-               (symbol-name :asdf))
-              ,(string-append system "-exec")))))
+   `((require :asdf)
+     (asdf:operate ',type ,(string-append system "-exec")))))
 
 (define (generate-executable-wrapper-system system dependencies)
   "Generates a system which can be used by asdf to produce an image or program
@@ -183,65 +248,59 @@ ENTRY-PROGRAM for SYSTEM within the current directory."
                       (declare (ignorable arguments))
                       ,@entry-program))))))))
 
-(define (wrap-perform-method lisp registry dependencies file-name)
-  "Creates a wrapper method which allows the system to locate its dependent
-systems from REGISTRY, an alist of the same form as %outputs, which contains
-lisp systems which the systems is dependent on.  All DEPENDENCIES which the
-system depends on will the be loaded before this system."
-  (let* ((system (string-drop-right (basename file-name) 4))
-         (system-symbol (string->lisp-keyword system)))
-
-    `(defmethod asdf:perform :before
-       (op (c (eql (asdf:find-system ,system-symbol))))
-       (asdf/source-registry:ensure-source-registry)
-       ,@(map (match-lambda
-                ((name . path)
-                 (let ((asd-file (string-append path
-                                                (bundle-install-prefix lisp)
-                                                "/" name ".asd")))
-                   `(setf
-                     (gethash ,name
-                              asdf/source-registry:*source-registry*)
-                     ,(string->symbol "#p")
-                     ,(bundle-asd-file path asd-file lisp)))))
-              registry)
-       ,@(map (lambda (system)
-                `(asdf:load-system ,(string->lisp-keyword system)))
-              dependencies))))
-
-(define (patch-asd-file asd-file registry lisp dependencies)
-  "Patches ASD-FILE with a perform method as described in WRAP-PERFORM-METHOD."
-  (chmod asd-file #o644)
-  (let ((port (open-file asd-file "a")))
-    (dynamic-wind
-      (lambda _ #t)
-      (lambda _
-        (display
-         (replace-escaped-macros
-          (format #f "~%~y~%"
-                  (wrap-perform-method lisp registry
-                                       dependencies asd-file)))
-         port))
-      (lambda _ (close-port port))))
-  (chmod asd-file #o444))
-
-(define (lisp-dependencies lisp inputs)
-  "Determine which inputs are lisp system dependencies, by using the convention
-that a lisp system dependency will resemble \"system-LISP\"."
-  (filter-map (match-lambda
-                ((name . value)
-                 (and (string-prefix? lisp name)
-                      (string<> lisp name)
-                      `(,(remove-lisp-from-name name lisp)
-                        . ,value))))
-              inputs))
-
-(define (bundle-asd-file output-path original-asd-file lisp)
+(define (generate-dependency-links registry system)
+  "Creates a program which populates asdf's source registry from REGISTRY, an
+alist of dependency names to corresponding asd files.  This allows the system
+to locate its dependent systems."
+  `(progn
+    (asdf/source-registry:ensure-source-registry)
+    ,@(map (match-lambda
+             ((name . asd-file)
+              `(setf
+                (gethash ,name
+                         asdf/source-registry:*source-registry*)
+                ,(string->symbol "#p")
+                ,asd-file)))
+           registry)))
+
+(define* (make-asd-file asd-file
+                        #:key system version inputs
+                        (system-asd-file #f))
+  "Create an ASD-FILE for SYSTEM@VERSION, appending a program to allow the
+system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS."
+  (define dependencies
+    (let ((deps
+           (system-dependencies system system-asd-file)))
+      (if (eq? 'NIL deps)
+          '()
+          (map normalize-string deps))))
+
+  (define lisp-input-map
+    (inputs->asd-file-map inputs))
+
+  (define registry
+    (filter-map hash-get-handle
+                (make-list (length dependencies)
+                           lisp-input-map)
+                dependencies))
+
+  (call-with-output-file asd-file
+    (lambda (port)
+      (display
+       (replace-escaped-macros
+        (format #f "~y~%~y~%"
+                (generate-system-definition system
+                                            #:version version
+                                            #:dependencies dependencies)
+                (generate-dependency-links registry system)))
+       port))))
+
+(define (bundle-asd-file output-path original-asd-file)
   "Find the symlinked bundle file for ORIGINAL-ASD-FILE by looking in
 OUTPUT-PATH/share/common-lisp/LISP-bundle-systems/<system>.asd.  Returns two
 values: the asd file itself and the directory in which it resides."
   (let ((bundle-asd-path (string-append output-path
-                                        (bundle-install-prefix lisp))))
+                                        (%bundle-install-prefix))))
     (values (string-append bundle-asd-path "/" (basename original-asd-file))
             bundle-asd-path)))
 
@@ -256,19 +315,22 @@ which are not nested."
   (setenv "CL_SOURCE_REGISTRY"
           (string-append path ":" (or (getenv "CL_SOURCE_REGISTRY") ""))))
 
-(define* (build-program lisp program #:key inputs
+(define* (build-program program outputs #:key
+                        (dependency-prefixes (list (library-output outputs)))
                         (dependencies (list (basename program)))
                         entry-program
                         #:allow-other-keys)
   "Generate an executable program containing all DEPENDENCIES, and which will
 execute ENTRY-PROGRAM.  The result is placed in PROGRAM.  When executed, it
 will run ENTRY-PROGRAM, a list of Common Lisp expressions in which `arguments'
-has been bound to the command-line arguments which were passed."
-  (generate-executable lisp program
-                       #:inputs inputs
+has been bound to the command-line arguments which were passed.  Link in any
+asd files from DEPENDENCY-PREFIXES to ensure references to those libraries are
+retained."
+  (generate-executable program
                        #:dependencies dependencies
+                       #:dependency-prefixes dependency-prefixes
                        #:entry-program entry-program
-                       #:type "program")
+                       #:type 'asdf:program-op)
   (let* ((name (basename program))
          (bin-directory (dirname program)))
     (with-directory-excursion bin-directory
@@ -276,16 +338,18 @@ has been bound to the command-line arguments which were passed."
                    name)))
   #t)
 
-(define* (build-image lisp image #:key inputs
+(define* (build-image image outputs #:key
+                      (dependency-prefixes (list (library-output outputs)))
                       (dependencies (list (basename image)))
                       #:allow-other-keys)
   "Generate an image, possibly standalone, which contains all DEPENDENCIES,
-placing the result in IMAGE.image."
-  (generate-executable lisp image
-                       #:inputs inputs
+placing the result in IMAGE.image.  Link in any asd files from
+DEPENDENCY-PREFIXES to ensure references to those libraries are retained."
+  (generate-executable image
                        #:dependencies dependencies
+                       #:dependency-prefixes dependency-prefixes
                        #:entry-program '(nil)
-                       #:type "image")
+                       #:type 'asdf:image-op)
   (let* ((name (basename image))
          (bin-directory (dirname image)))
     (with-directory-excursion bin-directory
@@ -293,14 +357,16 @@ placing the result in IMAGE.image."
                    (string-append name ".image"))))
   #t)
 
-(define* (generate-executable lisp out-file #:key inputs
+(define* (generate-executable out-file #:key
                               dependencies
+                              dependency-prefixes
                               entry-program
                               type
                               #:allow-other-keys)
-  "Generate an executable by using asdf's TYPE-op, containing whithin the
+  "Generate an executable by using asdf operation TYPE, containing whithin the
 image all DEPENDENCIES, and running ENTRY-PROGRAM in the case of an
-executable."
+executable.  Link in any asd files from DEPENDENCY-PREFIXES to ensure
+references to those libraries are retained."
   (let* ((bin-directory (dirname out-file))
          (name (basename out-file)))
     (mkdir-p bin-directory)
@@ -319,9 +385,25 @@ executable."
                `(((,bin-directory :**/ :*.*.*)
                   (,bin-directory :**/ :*.*.*)))))))
 
-    (parameterize ((%lisp (string-append
-                           (assoc-ref inputs lisp) "/bin/" lisp)))
-      (generate-executable-for-system type name lisp))
+    (generate-executable-for-system type name)
+
+    (let* ((after-store-prefix-index
+            (string-index out-file #\/
+                          (1+ (string-length (%store-directory)))))
+           (output (string-take out-file after-store-prefix-index))
+           (hidden-asd-links (string-append output "/.asd-files")))
+
+      (mkdir-p hidden-asd-links)
+      (for-each
+       (lambda (path)
+         (for-each
+          (lambda (asd-file)
+            (symlink asd-file
+                     (string-append hidden-asd-links
+                                    "/" (basename asd-file))))
+          (find-files (string-append path (%bundle-install-prefix))
+                      "\\.asd$")))
+       dependency-prefixes))
 
     (delete-file (string-append bin-directory "/" name "-exec.asd"))
     (delete-file (string-append bin-directory "/" name "-exec.lisp"))))
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 42eabfaf19..5c96fe9067 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -75,14 +75,14 @@ definitions for all the SEARCH-PATHS."
       ;;   source ~/.guix-profile/etc/profile ~/.guix-profile
       ;;
       ;; However, when 'source' is used with no arguments, $1 refers to the
-      ;; first positional parameter of the calling scripts, so we can rely on
-      ;; it.
+      ;; first positional parameter of the calling script, so we cannot rely
+      ;; on it.
       (display "\
 # Source this file to define all the relevant environment variables in Bash
 # for this profile.  You may want to define the 'GUIX_PROFILE' environment
 # variable to point to the \"visible\" name of the profile, like this:
 #
-#  GUIX_PROFILE=/path/to/profile
+#  GUIX_PROFILE=/path/to/profile \\
 #  source /path/to/profile/etc/profile
 #
 # When GUIX_PROFILE is undefined, the various environment variables refer
diff --git a/guix/build/pull.scm b/guix/build/pull.scm
index 6034e93cbf..d2e0404b14 100644
--- a/guix/build/pull.scm
+++ b/guix/build/pull.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -18,6 +18,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix build pull)
+  #:use-module (guix modules)
   #:use-module (guix build utils)
   #:use-module (system base compile)
   #:use-module (ice-9 ftw)
@@ -35,6 +36,56 @@
 ;;;
 ;;; Code:
 
+(define (depends-on-guile-ssh? file)
+  "Return true if FILE is a Scheme source file that depends, directly or
+indirectly, on Guile-SSH."
+  (find (match-lambda
+          (('ssh _ ...) #t)
+          (_ #f))
+        (source-module-closure file #:select? (const #t))))
+
+(define (all-scheme-files directory)
+  "Return a sorted list of Scheme files found in DIRECTORY."
+  ;; Load guix/ modules before gnu/ modules to get somewhat steadier
+  ;; progress reporting.
+  (sort (filter (cut string-suffix? ".scm" <>)
+                (find-files directory "\\.scm"))
+        (let ((guix (string-append directory "/guix"))
+              (gnu  (string-append directory "/gnu")))
+          (lambda (a b)
+            (or (and (string-prefix? guix a)
+                     (string-prefix? gnu  b))
+                (string<? a b))))))
+
+(cond-expand
+  (guile-2.2 (use-modules (language tree-il optimize)
+                          (language cps optimize)))
+  (else #f))
+
+(define %default-optimizations
+  ;; Default optimization options (equivalent to -O2 on Guile 2.2).
+  (cond-expand
+    (guile-2.2 (append (tree-il-default-optimization-options)
+                       (cps-default-optimization-options)))
+    (else '())))
+
+(define %lightweight-optimizations
+  ;; Lightweight optimizations (like -O0, but with partial evaluation).
+  (let loop ((opts %default-optimizations)
+             (result '()))
+    (match opts
+      (() (reverse result))
+      ((#:partial-eval? _ rest ...)
+       (loop rest `(#t #:partial-eval? ,@result)))
+      ((kw _ rest ...)
+       (loop rest `(#f ,kw ,@result))))))
+
+(define (optimization-options file)
+  (if (string-contains file "gnu/packages/")
+      %lightweight-optimizations                  ;build faster
+      '()))
+
+
 (define* (build-guix out source
                      #:key
                      system
@@ -55,7 +106,8 @@ containing the source code.  Write any debugging output to DEBUG-PORT."
   (setvbuf (current-error-port) _IOLBF)
 
   (with-directory-excursion source
-    (format #t "copying and compiling to '~a'...~%" out)
+    (format #t "copying and compiling to '~a' with Guile ~a...~%"
+            out (version))
 
     ;; Copy everything under guix/ and gnu/ plus {guix,gnu}.scm.
     (copy-recursively "guix" (string-append out "/guix")
@@ -92,17 +144,12 @@ containing the source code.  Write any debugging output to DEBUG-PORT."
 
     ;; Compile the .scm files.  Load all the files before compiling them to
     ;; work around <http://bugs.gnu.org/15602> (FIXME).
-    (let* ((files
-            ;; Load guix/ modules before gnu/ modules to get somewhat steadier
-            ;; progress reporting.
-            (sort (filter (cut string-suffix? ".scm" <>)
-                          (find-files out "\\.scm"))
-                  (let ((guix (string-append out "/guix"))
-                        (gnu  (string-append out "/gnu")))
-                    (lambda (a b)
-                      (or (and (string-prefix? guix a)
-                               (string-prefix? gnu  b))
-                          (string<? a b))))))
+    ;; Filter out files depending on Guile-SSH when Guile-SSH is missing.
+    (let* ((files (remove (if (false-if-exception
+                               (resolve-interface '(ssh session)))
+                              (const #f)
+                              depends-on-guile-ssh?)
+                          (all-scheme-files out)))
            (total (length files)))
       (let loop ((files files)
                  (completed 0))
@@ -140,7 +187,7 @@ containing the source code.  Write any debugging output to DEBUG-PORT."
              (parameterize ((current-warning-port (%make-void-port "w")))
                (compile-file file
                              #:output-file go
-                             #:opts %auto-compilation-options)))
+                             #:opts (optimization-options file))))
            (with-mutex mutex
              (set! completed (+ 1 completed))))
          files))))
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 5aae1530f4..0529c228a5 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,8 +45,6 @@
             MNT_EXPIRE
             UMOUNT_NOFOLLOW
             restart-on-EINTR
-            mount
-            umount
             mount-points
             swapon
             swapoff
@@ -83,17 +82,11 @@
 
             PF_PACKET
             AF_PACKET
-            IFF_UP
-            IFF_BROADCAST
-            IFF_LOOPBACK
             all-network-interface-names
             network-interface-names
-            network-interface-flags
             network-interface-netmask
             loopback-network-interface?
             network-interface-address
-            set-network-interface-flags
-            set-network-interface-address
             set-network-interface-netmask
             set-network-interface-up
             configure-network-interface
@@ -149,8 +142,19 @@
 ;;; Commentary:
 ;;;
 ;;; This module provides bindings to libc's syscall wrappers.  It uses the
-;;; FFI, and thus requires a dynamically-linked Guile.  (For statically-linked
-;;; Guile, we instead apply 'guile-linux-syscalls.patch'.)
+;;; FFI, and thus requires a dynamically-linked Guile.
+;;;
+;;; Some syscalls are already defined in statically-linked Guile by applying
+;;; 'guile-linux-syscalls.patch'.
+;;;
+;;; Visibility of syscall's symbols shared between this module and static Guile
+;;; is a bit delicate. It is handled by 'define-as-needed' macro.
+;;;
+;;; This macro is used to export symbols in dynamic Guile context, and to
+;;; re-export them in static Guile context.
+;;;
+;;; This way, even if they don't appear in #:export list, it is safe to use
+;;; syscalls from this module in static or dynamic Guile context.
 ;;;
 ;;; Code:
 
@@ -409,6 +413,25 @@ the returned procedure is called."
         (error (format #f "~a: syscall->procedure failed: ~s"
                        name args))))))
 
+(define-syntax define-as-needed
+  (syntax-rules ()
+    "Define VARIABLE.  If VARIABLE already exists in (guile) then re-export it,
+  otherwise export the newly-defined VARIABLE."
+    ((_ (proc args ...) body ...)
+     (define-as-needed proc (lambda* (args ...) body ...)))
+    ((_ variable value)
+     (begin
+       (when (module-defined? the-scm-module 'variable)
+         (re-export variable))
+
+       (define variable
+         (if (module-defined? the-scm-module 'variable)
+             (module-ref the-scm-module 'variable)
+             value))
+
+       (unless (module-defined? the-scm-module 'variable)
+         (export variable))))))
+
 
 ;;;
 ;;; File systems.
@@ -461,48 +484,50 @@ the returned procedure is called."
 (define MNT_EXPIRE      4)
 (define UMOUNT_NOFOLLOW 8)
 
-(define mount
+(define-as-needed (mount source target type
+                         #:optional (flags 0) options
+                         #:key (update-mtab? #f))
+  "Mount device SOURCE on TARGET as a file system TYPE.
+Optionally, FLAGS may be a bitwise-or of the MS_* <sys/mount.h>
+constants, and OPTIONS may be a string.  When FLAGS contains
+MS_REMOUNT, SOURCE and TYPE are ignored.  When UPDATE-MTAB? is true,
+update /etc/mtab.  Raise a 'system-error' exception on error."
+  ;; XXX: '#:update-mtab?' is not implemented by core 'mount'.
   (let ((proc (syscall->procedure int "mount" `(* * * ,unsigned-long *))))
-    (lambda* (source target type #:optional (flags 0) options
-                     #:key (update-mtab? #f))
-      "Mount device SOURCE on TARGET as a file system TYPE.  Optionally, FLAGS
-may be a bitwise-or of the MS_* <sys/mount.h> constants, and OPTIONS may be a
-string.  When FLAGS contains MS_REMOUNT, SOURCE and TYPE are ignored.  When
-UPDATE-MTAB? is true, update /etc/mtab.  Raise a 'system-error' exception on
-error."
-      (let-values (((ret err)
-                    (proc (if source
-                              (string->pointer source)
-                              %null-pointer)
-                          (string->pointer target)
-                          (if type
-                              (string->pointer type)
-                              %null-pointer)
-                          flags
-                          (if options
-                              (string->pointer options)
-                              %null-pointer))))
-        (unless (zero? ret)
-          (throw 'system-error "mount" "mount ~S on ~S: ~A"
-                 (list source target (strerror err))
-                 (list err)))
-        (when update-mtab?
-          (augment-mtab source target type options))))))
-
-(define umount
-  (let ((proc (syscall->procedure int "umount2" `(* ,int))))
-    (lambda* (target #:optional (flags 0)
-                     #:key (update-mtab? #f))
-      "Unmount TARGET.  Optionally FLAGS may be one of the MNT_* or UMOUNT_*
+    (let-values (((ret err)
+                  (proc (if source
+                            (string->pointer source)
+                            %null-pointer)
+                        (string->pointer target)
+                        (if type
+                            (string->pointer type)
+                            %null-pointer)
+                        flags
+                        (if options
+                            (string->pointer options)
+                            %null-pointer))))
+      (unless (zero? ret)
+        (throw 'system-error "mount" "mount ~S on ~S: ~A"
+               (list source target (strerror err))
+               (list err)))
+      (when update-mtab?
+        (augment-mtab source target type options)))))
+
+(define-as-needed (umount target
+                          #:optional (flags 0)
+                          #:key (update-mtab? #f))
+  "Unmount TARGET.  Optionally FLAGS may be one of the MNT_* or UMOUNT_*
 constants from <sys/mount.h>."
-      (let-values (((ret err)
-                    (proc (string->pointer target) flags)))
-        (unless (zero? ret)
-          (throw 'system-error "umount" "~S: ~A"
-                 (list target (strerror err))
-                 (list err)))
-        (when update-mtab?
-          (remove-from-mtab target))))))
+  ;; XXX: '#:update-mtab?' is not implemented by core 'umount'.
+  (let ((proc (syscall->procedure int "umount2" `(* ,int))))
+    (let-values (((ret err)
+                  (proc (string->pointer target) flags)))
+      (unless (zero? ret)
+        (throw 'system-error "umount" "~S: ~A"
+               (list target (strerror err))
+               (list err)))
+      (when update-mtab?
+        (remove-from-mtab target)))))
 
 (define (mount-points)
   "Return the mounts points for currently mounted file systems."
@@ -537,6 +562,34 @@ constants from <sys/mount.h>."
                  (list device (strerror err))
                  (list err)))))))
 
+(define-as-needed RB_AUTOBOOT    #x01234567)
+(define-as-needed RB_HALT_SYSTEM #xcdef0123)
+(define-as-needed RB_ENABLED_CAD #x89abcdef)
+(define-as-needed RB_DISABLE_CAD 0)
+(define-as-needed RB_POWER_OFF   #x4321fedc)
+(define-as-needed RB_SW_SUSPEND  #xd000fce2)
+(define-as-needed RB_KEXEC       #x45584543)
+
+(define-as-needed (reboot #:optional (cmd RB_AUTOBOOT))
+  (let ((proc (syscall->procedure int "reboot" (list int))))
+    (let-values (((ret err) (proc cmd)))
+      (unless (zero? ret)
+        (throw 'system-error "reboot" "~S: ~A"
+               (list cmd (strerror err))
+               (list err))))))
+
+(define-as-needed (load-linux-module data #:optional (options ""))
+  (let ((proc (syscall->procedure int "init_module"
+                                  (list '* unsigned-long '*))))
+    (let-values (((ret err)
+                  (proc (bytevector->pointer data)
+                        (bytevector-length data)
+                        (string->pointer options))))
+      (unless (zero? ret)
+        (throw 'system-error "load-linux-module" "~A"
+               (list (strerror err))
+               (list err))))))
+
 (define (kernel? pid)
   "Return #t if PID designates a \"kernel thread\" rather than a normal
 user-land process."
@@ -873,9 +926,9 @@ exception if it's already taken."
 
 ;; Flags and constants from <net/if.h>.
 
-(define IFF_UP #x1)                               ;Interface is up
-(define IFF_BROADCAST #x2)                        ;Broadcast address valid.
-(define IFF_LOOPBACK #x8)                         ;Is a loopback net.
+(define-as-needed IFF_UP #x1)                     ;Interface is up
+(define-as-needed IFF_BROADCAST #x2)              ;Broadcast address valid.
+(define-as-needed IFF_LOOPBACK #x8)               ;Is a loopback net.
 
 (define IF_NAMESIZE 16)                           ;maximum interface name size
 
@@ -1022,7 +1075,7 @@ that are not up."
                 (else
                  (loop interfaces))))))))
 
-(define (network-interface-flags socket name)
+(define-as-needed (network-interface-flags socket name)
   "Return a number that is the bit-wise or of 'IFF*' flags for network
 interface NAME."
   (let ((req (make-bytevector ifreq-struct-size)))
@@ -1033,8 +1086,8 @@ interface NAME."
                           (bytevector->pointer req))))
       (if (zero? ret)
 
-          ;; The 'ifr_flags' field is IF_NAMESIZE bytes after the beginning of
-          ;; 'struct ifreq', and it's a short int.
+          ;; The 'ifr_flags' field is IF_NAMESIZE bytes after the
+          ;; beginning of 'struct ifreq', and it's a short int.
           (bytevector-sint-ref req IF_NAMESIZE (native-endianness)
                                (sizeof short))
 
@@ -1050,7 +1103,7 @@ interface NAME."
     (close-port sock)
     (not (zero? (logand flags IFF_LOOPBACK)))))
 
-(define (set-network-interface-flags socket name flags)
+(define-as-needed (set-network-interface-flags socket name flags)
   "Set the flag of network interface NAME to FLAGS."
   (let ((req (make-bytevector ifreq-struct-size)))
     (bytevector-copy! (string->utf8 name) 0 req 0
@@ -1067,7 +1120,7 @@ interface NAME."
                (list name (strerror err))
                (list err))))))
 
-(define (set-network-interface-address socket name sockaddr)
+(define-as-needed (set-network-interface-address socket name sockaddr)
   "Set the address of network interface NAME to SOCKADDR."
   (let ((req (make-bytevector ifreq-struct-size)))
     (bytevector-copy! (string->utf8 name) 0 req 0
diff --git a/guix/build/union.scm b/guix/build/union.scm
index a2ea72e1f5..18167fa3e3 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -47,31 +47,34 @@
          (loop (cons file files)))))))
 
 (define (file-is-directory? file)
-  (eq? 'directory (stat:type (stat file))))
+  (match (stat file #f)
+    (#f #f)                                       ;maybe a dangling symlink
+    (st (eq? 'directory (stat:type st)))))
 
 (define (file=? file1 file2)
   "Return #t if FILE1 and FILE2 are regular files and their contents are
 identical, #f otherwise."
-  (let ((st1 (stat file1))
-        (st2 (stat file2)))
+  (let ((st1 (stat file1 #f))
+        (st2 (stat file2 #f)))
     ;; When deduplication is enabled, identical files share the same inode.
-    (or (= (stat:ino st1) (stat:ino st2))
-        (and (eq? (stat:type st1) 'regular)
-             (eq? (stat:type st2) 'regular)
-             (= (stat:size st1) (stat:size st2))
-             (call-with-input-file file1
-               (lambda (port1)
-                 (call-with-input-file file2
-                   (lambda (port2)
-                     (define len 8192)
-                     (define buf1 (make-bytevector len))
-                     (define buf2 (make-bytevector len))
-                     (let loop ()
-                       (let ((n1 (get-bytevector-n! port1 buf1 0 len))
-                             (n2 (get-bytevector-n! port2 buf2 0 len)))
-                         (and (equal? n1 n2)
-                              (or (eof-object? n1)
-                                  (loop)))))))))))))
+    (and st1 st2
+         (or (= (stat:ino st1) (stat:ino st2))
+             (and (eq? (stat:type st1) 'regular)
+                  (eq? (stat:type st2) 'regular)
+                  (= (stat:size st1) (stat:size st2))
+                  (call-with-input-file file1
+                    (lambda (port1)
+                      (call-with-input-file file2
+                        (lambda (port2)
+                          (define len 8192)
+                          (define buf1 (make-bytevector len))
+                          (define buf2 (make-bytevector len))
+                          (let loop ()
+                            (let ((n1 (get-bytevector-n! port1 buf1 0 len))
+                                  (n2 (get-bytevector-n! port2 buf2 0 len)))
+                              (and (equal? n1 n2)
+                                   (or (eof-object? n1)
+                                       (loop))))))))))))))
 
 (define* (union-build output inputs
                       #:key (log-port (current-error-port))