From a31174e896047e6a0f42b69db331fdeebb3cc995 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 4 Apr 2019 17:18:06 +0200
Subject: [PATCH] gexp: 'compiled-modules' loads modules before compiling them.

This works around <https://bugs.gnu.org/15602> in the context of
modules specified with 'with-imported-modules'.

* guix/gexp.scm (gexp->derivation): Add #:pre-load-modules? parameter
and pass it to 'compiled-modules'.
(compiled-modules): Add #:pre-load-modules? parameter and honor it.
* guix/packages.scm (patch-and-repack): Pass #:pre-load-modules? to
'gexp->derivation'.
---
 guix/gexp.scm     | 47 +++++++++++++++++++++++++++++++++++++++++++++--
 guix/packages.scm |  3 +++
 2 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 5b5b064b59..4f2adba90a 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -634,6 +634,11 @@ names and file names suitable for the #:allowed-references argument to
                            local-build? (substitutable? #t)
                            (properties '())
 
+                           ;; TODO: This parameter is transitional; it's here
+                           ;; to avoid a full rebuild.  Remove it on the next
+                           ;; rebuild cycle.
+                           (pre-load-modules? #t)
+
                            deprecation-warnings
                            (script-name (string-append name "-builder")))
   "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
@@ -738,6 +743,8 @@ The other arguments are as for 'derivation'."
                                                        #:module-path module-path
                                                        #:extensions extensions
                                                        #:guile guile-for-build
+                                                       #:pre-load-modules?
+                                                       pre-load-modules?
                                                        #:deprecation-warnings
                                                        deprecation-warnings)
                                      (return #f)))
@@ -1213,7 +1220,11 @@ last one is created from the given <scheme-file> object."
                            (guile (%guile-for-build))
                            (module-path %load-path)
                            (extensions '())
-                           (deprecation-warnings #f))
+                           (deprecation-warnings #f)
+
+                           ;; TODO: This flag is here to prevent a full
+                           ;; rebuild.  Remove it on the next rebuild cycle.
+                           (pre-load-modules? #t))
   "Return a derivation that builds a tree containing the `.go' files
 corresponding to MODULES.  All the MODULES are built in a context where
 they can refer to each other."
@@ -1246,7 +1257,12 @@ they can refer to each other."
                (let* ((base   (basename entry ".scm"))
                       (output (string-append output "/" base ".go")))
                  (format #t "[~2@a/~2@a] Compiling '~a'...~%"
-                         (+ 1 processed) (ungexp total) entry)
+                         (+ 1 processed
+                              (ungexp-splicing (if pre-load-modules?
+                                                   (gexp ((ungexp total)))
+                                                   (gexp ()))))
+                         (ungexp (* total (if pre-load-modules? 2 1)))
+                         entry)
                  (compile-file entry
                                #:output-file output
                                #:opts %auto-compilation-options)
@@ -1293,6 +1309,33 @@ they can refer to each other."
 
          (mkdir (ungexp output))
          (chdir (ungexp modules))
+
+         (ungexp-splicing
+          (if pre-load-modules?
+              (gexp ((define* (load-from-directory directory
+                                                   #:optional (loaded 0))
+                       "Load all the source files found in DIRECTORY."
+                       ;; XXX: This works around <https://bugs.gnu.org/15602>.
+                       (let ((entries (map (cut string-append directory "/" <>)
+                                           (scandir directory regular?))))
+                         (fold (lambda (file loaded)
+                                 (if (file-is-directory? file)
+                                     (load-from-directory file loaded)
+                                     (begin
+                                       (format #t "[~2@a/~2@a] Loading '~a'...~%"
+                                               (+ 1 loaded)
+                                               (ungexp (* 2 total))
+                                               file)
+                                       (save-module-excursion
+                                        (lambda ()
+                                          (primitive-load file)))
+                                       (+ 1 loaded))))
+                               loaded
+                               entries)))
+
+                     (load-from-directory ".")))
+              (gexp ())))
+
          (process-directory "." (ungexp output) 0))))
 
     ;; TODO: Pass MODULES as an environment variable.
diff --git a/guix/packages.scm b/guix/packages.scm
index c2981dda8b..c94a651f27 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -642,6 +642,9 @@ specifies modules in scope when evaluating SNIPPET."
 
     (let ((name (tarxz-name original-file-name)))
       (gexp->derivation name build
+                        ;; TODO: Remove this on the next rebuild cycle.
+                        #:pre-load-modules? #f
+
                         #:graft? #f
                         #:system system
                         #:deprecation-warnings #t ;to avoid a rebuild