From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:40291) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ie04K-0004ky-5r for guix-patches@gnu.org; Sun, 08 Dec 2019 12:10:05 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ie04I-0000XO-If for guix-patches@gnu.org; Sun, 08 Dec 2019 12:10:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46223) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ie04I-0000WB-CP for guix-patches@gnu.org; Sun, 08 Dec 2019 12:10:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ie04I-0003aY-6R for guix-patches@gnu.org; Sun, 08 Dec 2019 12:10:02 -0500 Subject: [bug#37730] [PATCH] Topologically sort recursively-imported packages Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= References: <87lfti5rip.fsf@gnu.org> Date: Sun, 08 Dec 2019 18:09:14 +0100 In-Reply-To: (Brian Leung's message of "Tue, 3 Dec 2019 15:06:51 -0800") Message-ID: <87immqpww5.fsf@gnu.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Brian Leung Cc: Ricardo Wurmus , 37730@debbugs.gnu.org, Efraim Flashner --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi Brian, Thanks for the updated patch! Brian Leung skribis: > From 915274d493116d063bfe2a953a9e855b8312711e Mon Sep 17 00:00:00 2001 > From: Brian Leung > Date: Fri, 11 Oct 2019 23:18:03 -0700 > Subject: [PATCH] guix: utils: Topologically sort recursively imported rec= ipes. [...] > + (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 reci= pe-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-packag= e 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=E2=80=99s fine with you, I=E2=80=99d 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=E2=80=99ve walked the whole dependency graph, so we indeed = have to get rid of streams. I guess it=E2=80=99s a tradeoff. Ricardo, how do y= ou feel about this change? Thanks! Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch Content-Disposition: inline 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 + (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)))) --=-=-=--