nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2017-04-19 16:11:25 +02:00
parent f2767d3e89
commit 2363bdd707
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 22 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
guix/gexp.scm
View File

@ -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)

4
tests/gexp.scm
View File

@ -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