From: Ulf Herrman <striness@tilde.club>
To: 63319@debbugs.gnu.org
Subject: bug#63319: [PATCH 3/3] profiles: remove `parent' field.
Date: Mon, 8 May 2023 15:33:35 -0500 [thread overview]
Message-ID: <20230508203335.30659-4-striness@tilde.club> (raw)
In-Reply-To: <20230508203335.30659-1-striness@tilde.club>
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))))))
\f
;;;
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
prev parent reply other threads:[~2023-05-09 7:03 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-05-05 20:32 bug#63319: Incorrect propagation chain reporting on profile collision Ulf Herrman
2023-05-08 20:33 ` bug#63319: [PATCH 0/3] Ulf Herrman
2023-05-08 20:33 ` bug#63319: [PATCH 1/3] profiles: include non-lowered entries and manifest in collision error Ulf Herrman
2023-05-08 20:33 ` bug#63319: [PATCH 2/3] ui: derive parents of profile collision entries from manifest Ulf Herrman
2023-05-08 20:33 ` Ulf Herrman [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20230508203335.30659-4-striness@tilde.club \
--to=striness@tilde.club \
--cc=63319@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.