diff mbox series

[bug#37730] Topologically sort recursively-imported packages

Message ID 87immqpww5.fsf@gnu.org
State Accepted
Headers show
Series [bug#37730] Topologically sort recursively-imported packages | expand

Commit Message

Ludovic Courtès Dec. 8, 2019, 5:09 p.m. UTC 
Hi Brian,

Thanks for the updated patch!

Brian Leung <bkleung89@gmail.com> skribis:

> From 915274d493116d063bfe2a953a9e855b8312711e Mon Sep 17 00:00:00 2001
> From: Brian Leung <leungbk@mailfence.com>
> Date: Fri, 11 Oct 2019 23:18:03 -0700
> Subject: [PATCH] guix: utils: Topologically sort recursively imported recipes.

[...]

> +  (define graph vlist-null)
> +  (define recipe-map vlist-null)
> +  (define stack (list package-name))
> +  (define accum '())
> +
> +  (define (topo-sort stack graph recipe-map accum)
> +    (if (null? stack)
> +        (reverse accum)
> +        (let ((head-package (car stack)))
> +          (match (vhash-assoc head-package graph)
> +            ((key . '())
> +             (let ((next-stack (cdr stack))
> +                   (next-accum (cons (cdr (vhash-assoc head-package recipe-map))
> +                                     accum)))
> +               (topo-sort next-stack
> +                          graph
> +                          recipe-map
> +                          next-accum)))
> +            ((key . (dep . rest))
> +             (define (handle? dep)
> +               (and
> +                (not (equal? dep head-package))
> +                (not (vhash-assoc dep recipe-map))
> +                (not (exists? dep))))
> +             (let* ((next-stack (if (handle? dep)
> +                                    (cons dep stack)
> +                                    stack))
> +                    (next-graph (vhash-cons key rest graph)))
> +               (topo-sort next-stack
> +                          next-graph
> +                          recipe-map
> +                          accum)))
> +            (#f
> +             (receive (package-recipe . dependencies) (repo->guix-package head-package repo)
> +               (let ((next-graph (vhash-cons head-package
> +                                             ;; dependencies has shape '(("package-a" "package-b" ...))
> +                                             (car dependencies)
> +                                             graph))
> +                     (next-recipe-map (vhash-cons head-package
> +                                                  (or
> +                                                   package-recipe
> +                                                   '())
> +                                                  recipe-map)))
> +                 (topo-sort stack
> +                            next-graph
> +                            next-recipe-map
> +                            accum))))))))
> +
> +  (topo-sort stack graph recipe-map accum))

I found this to be relatively complex (and part of this complexity was
already there before the patch) and quite different from the other
graph-walking procedures we have in different places, which got me
thinking why that is.

After a bit of researching and trying, I found that the attached patch
expresses the same thing, including topological sorting, in a hopefully
clearer way, or at least more consistent with other graph-walking
procedures in the code.  WDYT?

If that’s fine with you, I’d be willing to apply this patch, and then
apply other bits of your patch (the tests and stream removal) on top of
it.  How does that sound?

Returning a topologically-sorted set of packages means that nothing is
output until we’ve walked the whole dependency graph, so we indeed have
to get rid of streams.  I guess it’s a tradeoff.  Ricardo, how do you
feel about this change?

Thanks!

Ludo’.

Comments

Brian Leung Dec. 8, 2019, 6:31 p.m. UTC | #1 
Hi Ludo,

> If that’s fine with you, I’d be willing to apply this patch, and then
> apply other bits of your patch (the tests and stream removal) on top of
> it.  How does that sound?

Sure, your patch seems clearer to me.

Thanks,
Brian

On Sun, Dec 8, 2019 at 9:09 AM Ludovic Courtès <ludo@gnu.org> wrote:

> Hi Brian,
>
> Thanks for the updated patch!
>
> Brian Leung <bkleung89@gmail.com> skribis:
>
> > From 915274d493116d063bfe2a953a9e855b8312711e Mon Sep 17 00:00:00 2001
> > From: Brian Leung <leungbk@mailfence.com>
> > Date: Fri, 11 Oct 2019 23:18:03 -0700
> > Subject: [PATCH] guix: utils: Topologically sort recursively imported
> recipes.
>
> [...]
>
> > +  (define graph vlist-null)
> > +  (define recipe-map vlist-null)
> > +  (define stack (list package-name))
> > +  (define accum '())
> > +
> > +  (define (topo-sort stack graph recipe-map accum)
> > +    (if (null? stack)
> > +        (reverse accum)
> > +        (let ((head-package (car stack)))
> > +          (match (vhash-assoc head-package graph)
> > +            ((key . '())
> > +             (let ((next-stack (cdr stack))
> > +                   (next-accum (cons (cdr (vhash-assoc head-package
> recipe-map))
> > +                                     accum)))
> > +               (topo-sort next-stack
> > +                          graph
> > +                          recipe-map
> > +                          next-accum)))
> > +            ((key . (dep . rest))
> > +             (define (handle? dep)
> > +               (and
> > +                (not (equal? dep head-package))
> > +                (not (vhash-assoc dep recipe-map))
> > +                (not (exists? dep))))
> > +             (let* ((next-stack (if (handle? dep)
> > +                                    (cons dep stack)
> > +                                    stack))
> > +                    (next-graph (vhash-cons key rest graph)))
> > +               (topo-sort next-stack
> > +                          next-graph
> > +                          recipe-map
> > +                          accum)))
> > +            (#f
> > +             (receive (package-recipe . dependencies)
> (repo->guix-package head-package repo)
> > +               (let ((next-graph (vhash-cons head-package
> > +                                             ;; dependencies has shape
> '(("package-a" "package-b" ...))
> > +                                             (car dependencies)
> > +                                             graph))
> > +                     (next-recipe-map (vhash-cons head-package
> > +                                                  (or
> > +                                                   package-recipe
> > +                                                   '())
> > +                                                  recipe-map)))
> > +                 (topo-sort stack
> > +                            next-graph
> > +                            next-recipe-map
> > +                            accum))))))))
> > +
> > +  (topo-sort stack graph recipe-map accum))
>
> I found this to be relatively complex (and part of this complexity was
> already there before the patch) and quite different from the other
> graph-walking procedures we have in different places, which got me
> thinking why that is.
>
> After a bit of researching and trying, I found that the attached patch
> expresses the same thing, including topological sorting, in a hopefully
> clearer way, or at least more consistent with other graph-walking
> procedures in the code.  WDYT?
>
> If that’s fine with you, I’d be willing to apply this patch, and then
> apply other bits of your patch (the tests and stream removal) on top of
> it.  How does that sound?
>
> Returning a topologically-sorted set of packages means that nothing is
> output until we’ve walked the whole dependency graph, so we indeed have
> to get rid of streams.  I guess it’s a tradeoff.  Ricardo, how do you
> feel about this change?
>
> Thanks!
>
> Ludo’.
>
>
Ludovic Courtès Dec. 11, 2019, 11:26 a.m. UTC | #2 
Hi Brian,

Brian Leung <bkleung89@gmail.com> skribis:

>> If that’s fine with you, I’d be willing to apply this patch, and then
>> apply other bits of your patch (the tests and stream removal) on top of
>> it.  How does that sound?
>
> Sure, your patch seems clearer to me.

I pushed patches that combine mine and yours:

  4982de4c32 import: crate: Add recursive import test.
  70a8e13277 import: utils: 'recursive-import' returns a list rather than a stream.
  ddd5915900 import: utils: 'recursive-import' returns packages in topological order.

Let me know if you notice anything wrong!

Thank you,
Ludo’.
Ricardo Wurmus Dec. 12, 2019, 3:15 p.m. UTC | #3 
Ludovic Courtès <ludo@gnu.org> writes:

> Hi Brian,
>
> Brian Leung <bkleung89@gmail.com> skribis:
>
>>> If that’s fine with you, I’d be willing to apply this patch, and then
>>> apply other bits of your patch (the tests and stream removal) on top of
>>> it.  How does that sound?
>>
>> Sure, your patch seems clearer to me.
>
> I pushed patches that combine mine and yours:
>
>   4982de4c32 import: crate: Add recursive import test.
>   70a8e13277 import: utils: 'recursive-import' returns a list rather than a stream.
>   ddd5915900 import: utils: 'recursive-import' returns packages in topological order.

Thank you!

> Let me know if you notice anything wrong!

I believe the docstring of RECURSIVE-IMPORT in (guix import utils) needs
to be adjusted.  It still refers to streams.
Ludovic Courtès Dec. 12, 2019, 9:18 p.m. UTC | #4 
Hi,

Ricardo Wurmus <rekado@elephly.net> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Hi Brian,
>>
>> Brian Leung <bkleung89@gmail.com> skribis:
>>
>>>> If that’s fine with you, I’d be willing to apply this patch, and then
>>>> apply other bits of your patch (the tests and stream removal) on top of
>>>> it.  How does that sound?
>>>
>>> Sure, your patch seems clearer to me.
>>
>> I pushed patches that combine mine and yours:
>>
>>   4982de4c32 import: crate: Add recursive import test.
>>   70a8e13277 import: utils: 'recursive-import' returns a list rather than a stream.
>>   ddd5915900 import: utils: 'recursive-import' returns packages in topological order.
>
> Thank you!
>
>> Let me know if you notice anything wrong!
>
> I believe the docstring of RECURSIVE-IMPORT in (guix import utils) needs
> to be adjusted.  It still refers to streams.

Oops, fixed!  (Will push shortly.)

Thanks,
Ludo’.
diff mbox series

Patch

diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 4694b6e7ef..bdce902d87 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -34,12 +34,14 @@ 
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix download)
+  #:use-module (guix sets)
   #:use-module (gnu packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-41)
@@ -377,40 +379,51 @@  separated by PRED."
                                       (chr (char-downcase chr)))
                                     name)))
 
+(define (topological-sort nodes
+                          node-dependencies
+                          node-name)
+  "Perform a breadth-first traversal of the graph rooted at NODES, a list of
+nodes, and return the list of nodes sorted in topological order.  Call
+NODE-DEPENDENCIES to obtain the dependencies of a node, and NODE-NAME to
+obtain a node's uniquely identifying \"key\"."
+  (let loop ((nodes nodes)
+             (result '())
+             (visited (set)))
+    (match nodes
+      (()
+       (reverse result))
+      ((head . tail)
+       (if (set-contains? visited (node-name head))
+           (loop tail result visited)
+           (let ((dependencies (node-dependencies head)))
+             (loop (append dependencies tail)
+                   (cons head result)
+                   (set-insert (node-name head) visited))))))))
+
 (define* (recursive-import package-name repo
                            #:key repo->guix-package guix-name
                            #:allow-other-keys)
   "Generate a stream of package expressions for PACKAGE-NAME and all its
 dependencies."
-  (define (exists? dependency)
-    (not (null? (find-packages-by-name (guix-name dependency)))))
-  (define initial-state (list #f (list package-name) (list)))
-  (define (step state)
-    (match state
-      ((prev (next . rest) done)
-       (define (handle? dep)
-         (and
-           (not (equal? dep next))
-           (not (member dep done))
-           (not (exists? dep))))
-       (receive (package . dependencies) (repo->guix-package next repo)
-         (list
-           (if package package '()) ;; default #f on failure would interrupt
-           (if package
-             (lset-union equal? rest (filter handle? (car dependencies)))
-             rest)
-           (cons next done))))
-      ((prev '() done)
-       (list #f '() done))))
+  (define-record-type <node>
+    (make-node name package dependencies)
+    node?
+    (name         node-name)
+    (package      node-package)
+    (dependencies node-dependencies))
 
-  ;; Generate a lazy stream of package expressions for all unknown
-  ;; dependencies in the graph.
-  (stream-unfold
-    ;; map: produce a stream element
-    (match-lambda ((latest queue done) latest))
-    ;; predicate
-    (match-lambda ((latest queue done) latest))
-    ;; generator: update the queue
-    step
-    ;; initial state
-    (step initial-state)))
+  (define (exists? name)
+    (not (null? (find-packages-by-name (guix-name name)))))
+
+  (define (lookup-node name)
+    (receive (package dependencies) (repo->guix-package name repo)
+      (make-node name package dependencies)))
+
+  (list->stream                                   ;TODO: remove streams
+   (map node-package
+        (topological-sort (list (lookup-node package-name))
+                          (lambda (node)
+                            (map lookup-node
+                                 (remove exists?
+                                         (node-dependencies node))))
+                          node-name))))