summaryrefslogtreecommitdiff
path: root/guix/gexp.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-10-27 15:45:45 +0200
committerLudovic Courtès <ludo@gnu.org>2018-10-27 16:39:29 +0200
commit932d1600564cbf359a6ccd1086b968a934bef8e5 (patch)
tree36b8f047e54ec51c1638510405e9e8283171e963 /guix/gexp.scm
parent003789e837d8524edf524e25fd753dbd801b583f (diff)
downloadgnu-guix-932d1600564cbf359a6ccd1086b968a934bef8e5.tar
gnu-guix-932d1600564cbf359a6ccd1086b968a934bef8e5.tar.gz
gexp: 'gexp-modules' now consistently deletes duplicates.
Fixes <https://bugs.gnu.org/32966>. Reported by Clément Lassieur <clement@lassieur.org>. * guix/gexp.scm (gexp-attribute): Add 'equal?' optional parameter; pass it to 'delete-duplicates'. (gexp-modules)[module=?]: New procedure. Pass it to 'gexp-attribute'. * tests/gexp.scm ("gexp-modules deletes duplicates"): New test.
Diffstat (limited to 'guix/gexp.scm')
-rw-r--r--guix/gexp.scm25
1 files changed, 21 insertions, 4 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index ba0d642b17..537875b6b7 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -506,9 +506,10 @@ whether this should be considered a \"native\" input or not."
(set-record-type-printer! <gexp-output> write-gexp-output)
-(define (gexp-attribute gexp self-attribute)
+(define* (gexp-attribute gexp self-attribute #:optional (equal? equal?))
"Recurse on GEXP and the expressions it refers to, summing the items
-returned by SELF-ATTRIBUTE, a procedure that takes a gexp."
+returned by SELF-ATTRIBUTE, a procedure that takes a gexp. Use EQUAL? as the
+second argument to 'delete-duplicates'."
(if (gexp? gexp)
(delete-duplicates
(append (self-attribute gexp)
@@ -524,13 +525,29 @@ returned by SELF-ATTRIBUTE, a procedure that takes a gexp."
lst))
(_
'()))
- (gexp-references gexp))))
+ (gexp-references gexp)))
+ equal?)
'())) ;plain Scheme data type
(define (gexp-modules 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."
- (gexp-attribute gexp gexp-self-modules))
+ (define (module=? m1 m2)
+ ;; Return #t when M1 equals M2. Special-case '=>' specs because their
+ ;; right-hand side may not be comparable with 'equal?': it's typically a
+ ;; file-like object that embeds a gexp, which in turn embeds closure;
+ ;; those closures may be 'eq?' when running compiled code but are unlikely
+ ;; to be 'eq?' when running on 'eval'. Ignore the right-hand side to
+ ;; avoid this discrepancy.
+ (match m1
+ (((name1 ...) '=> _)
+ (match m2
+ (((name2 ...) '=> _) (equal? name1 name2))
+ (_ #f)))
+ (_
+ (equal? m1 m2))))
+
+ (gexp-attribute gexp gexp-self-modules module=?))
(define (gexp-extensions gexp)
"Return the list of Guile extensions (packages) GEXP relies on. If (gexp?