~ruther/guix-local

2363bdd707ba382d89c96e03c04038c047d7228c — Ludovic Courtès 8 years ago f2767d3
gexp: 'gexp-modules' accepts plain Scheme objects.

* guix/gexp.scm (gexp-modules): Return '() when not (gexp? GEXP).
* tests/gexp.scm ("gexp-modules and literal Scheme object"): New test.
2 files changed, 22 insertions(+), 15 deletions(-)

M guix/gexp.scm
M tests/gexp.scm
M guix/gexp.scm => guix/gexp.scm +18 -15
@@ 459,21 459,24 @@ whether this should be considered a \"native\" input or not."
(set-record-type-printer! <gexp-output> write-gexp-output)

(define (gexp-modules gexp)
  "Return the list of Guile module names GEXP relies on."
  (delete-duplicates
   (append (gexp-self-modules gexp)
           (append-map (match-lambda
                         (($ <gexp-input> (? gexp? exp))
                          (gexp-modules exp))
                         (($ <gexp-input> (lst ...))
                          (append-map (lambda (item)
                                        (if (gexp? item)
                                            (gexp-modules item)
                                            '()))
                                      lst))
                         (_
                          '()))
                       (gexp-references gexp)))))
  "Return the list of Guile module names GEXP relies on.  If (gexp? GEXP) is
false, meaning that GEXP is a plain Scheme object, return the empty list."
  (if (gexp? gexp)
      (delete-duplicates
       (append (gexp-self-modules gexp)
               (append-map (match-lambda
                             (($ <gexp-input> (? gexp? exp))
                              (gexp-modules exp))
                             (($ <gexp-input> (lst ...))
                              (append-map (lambda (item)
                                            (if (gexp? item)
                                                (gexp-modules item)
                                                '()))
                                          lst))
                             (_
                              '()))
                           (gexp-references gexp))))
      '()))                                       ;plain Scheme data type

(define* (lower-inputs inputs
                       #:key system target)

M tests/gexp.scm => tests/gexp.scm +4 -0
@@ 627,6 627,10 @@
   #~(foo #$@(list (with-imported-modules '((foo)) #~+)
                   (with-imported-modules '((bar)) #~-)))))

(test-equal "gexp-modules and literal Scheme object"
  '()
  (gexp-modules #t))

(test-assertm "gexp->derivation #:modules"
  (mlet* %store-monad
      ((build ->  #~(begin