From patchwork Sun Dec 8 17:09:14 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 16434 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id B612717873; Sun, 8 Dec 2019 17:10:16 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 5A17417863 for ; Sun, 8 Dec 2019 17:10:16 +0000 (GMT) Received: from localhost ([::1]:60260 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ie04V-0004nJ-OZ for patchwork@mira.cbaines.net; Sun, 08 Dec 2019 12:10:15 -0500 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 X-Loop: help-debbugs@gnu.org Subject: [bug#37730] [PATCH] Topologically sort recursively-imported packages Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 08 Dec 2019 17:10:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 37730 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Brian Leung Cc: Ricardo Wurmus , 37730@debbugs.gnu.org, Efraim Flashner Received: via spool by 37730-submit@debbugs.gnu.org id=B37730.157582497013750 (code B ref 37730); Sun, 08 Dec 2019 17:10:02 +0000 Received: (at 37730) by debbugs.gnu.org; 8 Dec 2019 17:09:30 +0000 Received: from localhost ([127.0.0.1]:52195 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ie03m-0003Zi-2o for submit@debbugs.gnu.org; Sun, 08 Dec 2019 12:09:30 -0500 Received: from eggs.gnu.org ([209.51.188.92]:57970) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ie03k-0003ZV-9Q for 37730@debbugs.gnu.org; Sun, 08 Dec 2019 12:09:28 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:47045) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ie03c-000606-RC; Sun, 08 Dec 2019 12:09:22 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=60518 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1ie03c-00048j-Ei; Sun, 08 Dec 2019 12:09:20 -0500 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> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches 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 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’. 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))))