Package: guix;
Reported by: Ulf Herrman <striness <at> tilde.club>
Date: Fri, 5 May 2023 20:34:01 UTC
Severity: normal
View this message in rfc822 format
From: Ulf Herrman <striness <at> tilde.club> To: 63319 <at> debbugs.gnu.org Subject: bug#63319: [PATCH 3/3] profiles: remove `parent' field. Date: Mon, 8 May 2023 15:33:35 -0500
This field was only present for consumption by (guix ui) when reporting
propagation chains that lead to profile collision errors, but it is only valid
in general with respect to a single manifest. (guix ui) now derives parent
information by itself with respect to an explicit manifest, so this field is
no longer needed.
* guix/profiles.scm (manifest-entry-parent): remove field.
(package->manifest-entry, sexp->manifest): do not populate it.
(manifest->gexp): adjust match specifications to account for its absence.
* guix/inferior.scm (inferior-package->manifest-entry): do not populate
nonexistent parent field.
---
guix/inferior.scm | 36 ++++++--------
guix/profiles.scm | 123 +++++++++++++++++++---------------------------
2 files changed, 67 insertions(+), 92 deletions(-)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 5dfd30a6c8..4030640f6d 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -819,27 +819,23 @@ (define-syntax-rule (memoized package output exp)
result))))
(let loop ((package package)
- (output output)
- (parent (delay #f)))
+ (output output))
(memoized package output
- ;; For each dependency, keep a promise pointing to its "parent" entry.
- (letrec* ((deps (map (match-lambda
- ((label package)
- (loop package "out" (delay entry)))
- ((label package output)
- (loop package output (delay entry))))
- (inferior-package-propagated-inputs package)))
- (entry (manifest-entry
- (name (inferior-package-name package))
- (version (inferior-package-version package))
- (output output)
- (item package)
- (dependencies (delete-duplicates deps))
- (search-paths
- (inferior-package-transitive-native-search-paths package))
- (parent parent)
- (properties properties))))
- entry))))
+ (let ((deps (map (match-lambda
+ ((label package)
+ (loop package "out"))
+ ((label package output)
+ (loop package output)))
+ (inferior-package-propagated-inputs package))))
+ (manifest-entry
+ (name (inferior-package-name package))
+ (version (inferior-package-version package))
+ (output output)
+ (item package)
+ (dependencies (delete-duplicates deps))
+ (search-paths
+ (inferior-package-transitive-native-search-paths package))
+ (properties properties))))))
;;;
diff --git a/guix/profiles.scm b/guix/profiles.scm
index b812a6f7d9..0d22667362 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -90,7 +90,6 @@ (define-module (guix profiles)
manifest-entry-item
manifest-entry-dependencies
manifest-entry-search-paths
- manifest-entry-parent
manifest-entry-properties
lower-manifest-entry
@@ -229,8 +228,6 @@ (define-record-type* <manifest-entry> manifest-entry
(default '()))
(search-paths manifest-entry-search-paths ; search-path-specification*
(default '()))
- (parent manifest-entry-parent ; promise (#f | <manifest-entry>)
- (default (delay #f)))
(properties manifest-entry-properties ; list of symbol/value pairs
(default '())))
@@ -416,29 +413,23 @@ (define (default-properties package)
(transformations `((transformations . ,transformations)))))
(define* (package->manifest-entry package #:optional (output "out")
- #:key (parent (delay #f))
(properties (default-properties package)))
"Return a manifest entry for the OUTPUT of package PACKAGE."
- ;; For each dependency, keep a promise pointing to its "parent" entry.
- (letrec* ((deps (map (match-lambda
- ((label package)
- (package->manifest-entry package
- #:parent (delay entry)))
- ((label package output)
- (package->manifest-entry package output
- #:parent (delay entry))))
- (package-propagated-inputs package)))
- (entry (manifest-entry
- (name (package-name package))
- (version (package-version package))
- (output output)
- (item package)
- (dependencies (delete-duplicates deps))
- (search-paths
- (package-transitive-native-search-paths package))
- (parent parent)
- (properties properties))))
- entry))
+ (let ((deps (map (match-lambda
+ ((label package)
+ (package->manifest-entry package))
+ ((label package output)
+ (package->manifest-entry package output)))
+ (package-propagated-inputs package))))
+ (manifest-entry
+ (name (package-name package))
+ (version (package-version package))
+ (output output)
+ (item package)
+ (dependencies (delete-duplicates deps))
+ (search-paths
+ (package-transitive-native-search-paths package))
+ (properties properties))))
(define* (package->development-manifest package
#:optional
@@ -534,7 +525,7 @@ (define (entry->gexp entry)
(return
(match entry
(($ <manifest-entry> name version output (? string? path)
- (_ ...) (search-paths ...) _ (properties ...))
+ (_ ...) (search-paths ...) (properties ...))
#~(#$name #$version #$output #$path
#$@(optional 'propagated-inputs deps)
#$@(optional 'search-paths
@@ -542,7 +533,7 @@ (define (entry->gexp entry)
search-paths))
#$@(optional 'properties properties)))
(($ <manifest-entry> name version output package
- (_deps ...) (search-paths ...) _ (properties ...))
+ (_deps ...) (search-paths ...) (properties ...))
#~(#$name #$version #$output
(ungexp package (or output "out"))
#$@(optional 'propagated-inputs deps)
@@ -565,7 +556,7 @@ (define (entry->gexp entry)
(define (sexp->manifest sexp)
"Parse SEXP as a manifest."
- (define (infer-dependency item parent)
+ (define (infer-dependency item)
;; Return a <manifest-entry> for ITEM.
(let-values (((name version)
(package-name->name+version
@@ -573,31 +564,25 @@ (define (infer-dependency item parent)
(manifest-entry
(name name)
(version version)
- (item item)
- (parent parent))))
+ (item item))))
- (define* (sexp->manifest-entry/v3 sexp #:optional (parent (delay #f)))
+ (define* (sexp->manifest-entry/v3 sexp)
;; Read SEXP as a version 3 manifest entry.
(match sexp
((name version output path
('propagated-inputs deps)
('search-paths search-paths)
extra-stuff ...)
- ;; For each of DEPS, keep a promise pointing to ENTRY.
- (letrec* ((deps* (map (cut sexp->manifest-entry/v3 <> (delay entry))
- deps))
- (entry (manifest-entry
- (name name)
- (version version)
- (output output)
- (item path)
- (dependencies deps*)
- (search-paths (map sexp->search-path-specification
- search-paths))
- (parent parent)
- (properties (or (assoc-ref extra-stuff 'properties)
- '())))))
- entry))))
+ (manifest-entry
+ (name name)
+ (version version)
+ (output output)
+ (item path)
+ (dependencies (map sexp->manifest-entry/v3 deps))
+ (search-paths (map sexp->search-path-specification
+ search-paths))
+ (properties (or (assoc-ref extra-stuff 'properties)
+ '()))))))
(define-syntax let-fields
(syntax-rules ()
@@ -611,7 +596,7 @@ (define-syntax let-fields
((_ lst () body ...)
(begin body ...))))
- (define* (sexp->manifest-entry sexp #:optional (parent (delay #f)))
+ (define* (sexp->manifest-entry sexp)
(match sexp
(('repeated name version path)
;; This entry is the same as another one encountered earlier; look it
@@ -628,23 +613,20 @@ (define* (sexp->manifest-entry sexp #:optional (parent (delay #f)))
((name version output path fields ...)
(let-fields fields (propagated-inputs search-paths properties)
(mlet* %state-monad
- ((entry -> #f)
- (deps (mapm %state-monad
- (cut sexp->manifest-entry <> (delay entry))
+ ((deps (mapm %state-monad
+ sexp->manifest-entry
propagated-inputs))
+ (entry -> (manifest-entry
+ (name name)
+ (version version)
+ (output output)
+ (item path)
+ (dependencies deps)
+ (search-paths (map sexp->search-path-specification
+ search-paths))
+ (properties properties)))
(visited (current-state))
(key -> (list name version path)))
- (set! entry ;XXX: emulate 'letrec*'
- (manifest-entry
- (name name)
- (version version)
- (output output)
- (item path)
- (dependencies deps)
- (search-paths (map sexp->search-path-specification
- search-paths))
- (parent parent)
- (properties properties)))
(mbegin %state-monad
(set-current-state (vhash-cons key entry visited))
(return entry)))))))
@@ -661,18 +643,15 @@ (define* (sexp->manifest-entry sexp #:optional (parent (delay #f)))
...)))
(manifest
(map (lambda (name version output path deps search-paths)
- (letrec* ((deps* (map (cute infer-dependency <> (delay entry))
- deps))
- (entry (manifest-entry
- (name name)
- (version version)
- (output output)
- (item path)
- (dependencies deps*)
- (search-paths
- (map sexp->search-path-specification
- search-paths)))))
- entry))
+ (manifest-entry
+ (name name)
+ (version version)
+ (output output)
+ (item path)
+ (dependencies (map infer-dependency deps))
+ (search-paths
+ (map sexp->search-path-specification
+ search-paths))))
name version output path deps search-paths)))
;; Version 3 represents DEPS as full-blown manifest entries.
--
2.39.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.