Subject: bug#63319: [PATCH 3/3] profiles: remove `parent' field.

From: Ulf Herrman <[email-masked]>
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