07/08: gexp: 'scheme-file' can splice expressions.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 4fbd1a2b7f0db819e14d7cc862445d9ab3d0d80f
Author: Ludovic Courtès <address@hidden>
Date:   Wed Apr 11 00:52:40 2018 +0200

    gexp: 'scheme-file' can splice expressions.
    
    * guix/gexp.scm (<scheme-file>)[splice?]: New field.
    (scheme-file): Add #:splice? and pass it to '%scheme-file'.
    (scheme-file-compiler): Pass SPLICE? to 'gexp->file'.
    (gexp->file): Add #:splice? and honor it.
    * tests/gexp.scm ("gexp->file + #:splice?"): New test.
    ("gexp->derivation & with-imported-module & computed module"): Use
     #:splice? #t.
---
 doc/guix.texi  |  6 +++++-
 guix/gexp.scm  | 39 ++++++++++++++++++++++++++-------------
 tests/gexp.scm | 23 +++++++++++++++++++++--
 3 files changed, 52 insertions(+), 16 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 738fdf6..d825f39 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5221,8 +5221,12 @@ This is the declarative counterpart of 
@code{gexp->script}.
 
 @deffn {Monadic Procedure} gexp->file @var{name} @var{exp} @
             [#:set-load-path? #t] [#:module-path %load-path] @
+            [#:splice? #f] @
             [#:guile (default-guile)]
 Return a derivation that builds a file @var{name} containing @var{exp}.
+When @var{splice?}  is true, @var{exp} is considered to be a list of
+expressions that will be spliced in the resulting file.
+
 When @var{set-load-path?} is true, emit code in the resulting file to
 set @code{%load-path} and @code{%load-compiled-path} to honor
 @var{exp}'s imported modules.  Look up @var{exp}'s modules in
@@ -5232,7 +5236,7 @@ The resulting file holds references to all the 
dependencies of @var{exp}
 or a subset thereof.
 @end deffn
 
address@hidden {Scheme Procedure} scheme-file @var{name} @var{exp}
address@hidden {Scheme Procedure} scheme-file @var{name} @var{exp} [#:splice? 
#f]
 Return an object representing the Scheme file @var{name} that contains
 @var{exp}.
 
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 448eeed..d26fad7 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -406,23 +406,24 @@ This is the declarative counterpart of 'gexp->script'."
                    #:guile (or guile (default-guile))))))
 
 (define-record-type <scheme-file>
-  (%scheme-file name gexp)
+  (%scheme-file name gexp splice?)
   scheme-file?
   (name       scheme-file-name)                  ;string
-  (gexp       scheme-file-gexp))                 ;gexp
+  (gexp       scheme-file-gexp)                  ;gexp
+  (splice?    scheme-file-splice?))              ;Boolean
 
-(define* (scheme-file name gexp)
+(define* (scheme-file name gexp #:key splice?)
   "Return an object representing the Scheme file NAME that contains GEXP.
 
 This is the declarative counterpart of 'gexp->file'."
-  (%scheme-file name gexp))
+  (%scheme-file name gexp splice?))
 
 (define-gexp-compiler (scheme-file-compiler (file <scheme-file>)
                                             system target)
   ;; Compile FILE by returning a derivation that builds the file.
   (match file
-    (($ <scheme-file> name gexp)
-     (gexp->file name gexp))))
+    (($ <scheme-file> name gexp splice?)
+     (gexp->file name gexp #:splice? splice?))))
 
 ;; Appending SUFFIX to BASE's output file name.
 (define-record-type <file-append>
@@ -1162,18 +1163,26 @@ imported modules in its search path.  Look up EXP's 
modules in MODULE-PATH."
 
 (define* (gexp->file name exp #:key
                      (set-load-path? #t)
-                     (module-path %load-path))
-  "Return a derivation that builds a file NAME containing EXP.  When
-SET-LOAD-PATH? is true, emit code in the resulting file to set '%load-path'
-and '%load-compiled-path' to honor EXP's imported modules.  Lookup EXP's
-modules in MODULE-PATH."
+                     (module-path %load-path)
+                     (splice? #f))
+  "Return a derivation that builds a file NAME containing EXP.  When SPLICE?
+is true, EXP is considered to be a list of expressions that will be spliced in
+the resulting file.
+
+When SET-LOAD-PATH? is true, emit code in the resulting file to set
+'%load-path' and '%load-compiled-path' to honor EXP's imported modules.
+Lookup EXP's modules in MODULE-PATH."
   (match (if set-load-path? (gexp-modules exp) '())
     (()                                           ;zero modules
      (gexp->derivation name
                        (gexp
                         (call-with-output-file (ungexp output)
                           (lambda (port)
-                            (write '(ungexp exp) port))))
+                            (for-each (lambda (exp)
+                                        (write exp port))
+                                      '(ungexp (if splice?
+                                                   exp
+                                                   (gexp ((ungexp exp)))))))))
                        #:local-build? #t
                        #:substitutable? #f))
     ((modules ...)
@@ -1184,7 +1193,11 @@ modules in MODULE-PATH."
                           (call-with-output-file (ungexp output)
                             (lambda (port)
                               (write '(ungexp set-load-path) port)
-                              (write '(ungexp exp) port))))
+                              (for-each (lambda (exp)
+                                          (write exp port))
+                                        '(ungexp (if splice?
+                                                     exp
+                                                     (gexp ((ungexp 
exp)))))))))
                          #:module-path module-path
                          #:local-build? #t
                          #:substitutable? #f)))))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 2f8940e..3c8b462 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -419,6 +419,24 @@
                          (call-with-input-file out read))
                  (equal? (list guile) refs)))))
 
+(test-assertm "gexp->file + #:splice?"
+  (mlet* %store-monad ((exp -> (list
+                                #~(define foo 'bar)
+                                #~(define guile #$%bootstrap-guile)))
+                       (guile  (package-file %bootstrap-guile))
+                       (drv    (gexp->file "splice" exp #:splice? #t))
+                       (out -> (derivation->output-path drv))
+                       (done   (built-derivations (list drv)))
+                       (refs   (references* out)))
+    (pk 'splice out)
+    (return (and (equal? `((define foo 'bar)
+                           (define guile ,guile)
+                           ,(call-with-input-string "" read))
+                         (call-with-input-file out
+                           (lambda (port)
+                             (list (read port) (read port) (read port)))))
+                 (equal? (list guile) refs)))))
+
 (test-assertm "gexp->derivation"
   (mlet* %store-monad ((file    (text-file "foo" "Hello, world!"))
                        (exp ->  (gexp
@@ -700,11 +718,12 @@
 
 (test-assertm "gexp->derivation & with-imported-module & computed module"
   (mlet* %store-monad
-      ((module -> (scheme-file "x" #~(begin
+      ((module -> (scheme-file "x" #~(;; splice!
                                        (define-module (foo bar)
                                          #:export (the-answer))
 
-                                       (define the-answer 42))))
+                                       (define the-answer 42))
+                               #:splice? #t))
        (build -> (with-imported-modules `(((foo bar) => ,module)
                                           (guix build utils))
                    #~(begin