From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id AI8fJOUIXGGk4wAAgWs5BA (envelope-from ) for ; Tue, 05 Oct 2021 10:12:21 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id EJ6+H+UIXGFqSAAAbx9fmQ (envelope-from ) for ; Tue, 05 Oct 2021 08:12:21 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id CDBF719341 for ; Tue, 5 Oct 2021 10:12:20 +0200 (CEST) Received: from localhost ([::1]:48936 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mXfYg-0007xQ-3l for larch@yhetil.org; Tue, 05 Oct 2021 04:12:18 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:45942) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mXfSd-0002Sd-4b for bug-guix@gnu.org; Tue, 05 Oct 2021 04:06:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55667) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mXfSb-0002J5-Pq for bug-guix@gnu.org; Tue, 05 Oct 2021 04:06:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mXfSb-0007TQ-Kl for bug-guix@gnu.org; Tue, 05 Oct 2021 04:06:01 -0400 X-Loop: help-debbugs@gnu.org Subject: bug#51021: detect loops in module/package graph Resent-From: Mark H Weaver Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Tue, 05 Oct 2021 08:06:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 51021 X-GNU-PR-Package: guix X-GNU-PR-Keywords: To: raingloom , 51021@debbugs.gnu.org Received: via spool by 51021-submit@debbugs.gnu.org id=B51021.163342112128673 (code B ref 51021); Tue, 05 Oct 2021 08:06:01 +0000 Received: (at 51021) by debbugs.gnu.org; 5 Oct 2021 08:05:21 +0000 Received: from localhost ([127.0.0.1]:38980 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mXfRw-0007SP-GU for submit@debbugs.gnu.org; Tue, 05 Oct 2021 04:05:20 -0400 Received: from world.peace.net ([64.112.178.59]:34568) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mXfRu-0007SA-QU for 51021@debbugs.gnu.org; Tue, 05 Oct 2021 04:05:19 -0400 Received: from mhw by world.peace.net with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mXfRo-0006MY-BZ; Tue, 05 Oct 2021 04:05:12 -0400 From: Mark H Weaver In-Reply-To: <87czojkilc.fsf@netris.org> References: <20211005025819.3f7756d7@riseup.net> <87czojkilc.fsf@netris.org> Date: Tue, 05 Oct 2021 04:03:24 -0400 Message-ID: <87a6jnkie0.fsf@netris.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-guix@gnu.org List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1633421540; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type:resent-cc:resent-from:resent-sender: resent-message-id:in-reply-to:in-reply-to:references:references: list-id:list-help:list-unsubscribe:list-subscribe:list-post; bh=FL77QYqpx+o16Y1+QIH+zObHP0wOhfSiqr5Fg4sZpzs=; b=r7S2ToAVP813E0WPOGLZb9vqkRHkXmRrO7mQ373xAY1vXIyjDWxrTRmyEnadAON6zV+2ag a1ZDs2OW4yPGAZKM4zfOJlEASVl5pmo4OH3QTSiJI98gWdBtOL0BKtuS1HmnNA5NBub3dC G1Cy0x4N8TyR7vFCp5VR7knbeSQZour8UI1Co5r+MekmcbQVDB0HLW/ls6mLW2Wb9ZQo/K Jffau8AssntglsddTBQSNLXhyZqP3A8oN4m+AnqaA9A+/FFjL+ij2LH8lvynW1Wh3j8wT5 zWnQFol9L6tlTJYk5kiuIu8aawRInDAIsYkfzWGTVjj7qle0cpCQ7lsTbGZOwQ== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1633421540; a=rsa-sha256; cv=none; b=EUYIEaouLRmyoca4fOG7dTUX+WxwEbxsW44MDnH2oK15u2tPoJJn/Xc0q0tQ+RXHwnvE/k cGI24ijcufu+dmrIpanHWDmsXuCEr4qEGTg6V9xMvueafrEp0ZZSU3ZdvqqWXR1WIe9qfU SguRRXJar/oC07Z7g39jK/z3Y4NEIz4HDBM48BYg+zpl2D0+9jTVmN3ySqczojgaOHQxCn Tm4VzMsmVm1LsMkpfWtrxOxBm5+9tvjlh+G6Dova/FlQkX9QOKgttSVsD4S5jwDH1yWMU8 fN7uvUkZSIFB6DmWk0IvKDN04gzyHU+0mEDhWa+n/jFGzoqBZ4Akb7vc1ybqjA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; spf=pass (aspmx1.migadu.com: domain of bug-guix-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=bug-guix-bounces@gnu.org X-Migadu-Spam-Score: -1.41 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of bug-guix-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=bug-guix-bounces@gnu.org X-Migadu-Queue-Id: CDBF719341 X-Spam-Score: -1.41 X-Migadu-Scanner: scn0.migadu.com X-TUID: AFGQg+0/bJ3R --=-=-= Content-Type: text/plain Earlier, I wrote > I've attached a script that I hacked up in 2014 to analyze the Guix > package module dependency graph. Here's the script: --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=cycle-viewer.scm Content-Description: cycle-viewer.scm ;;; cycle-viewer.scm: a Guix package module dependency graph analyzer ;;; Copyright (C) 2014 Mark H Weaver ;;; ;;; This program is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation, either version 3 of the License, or ;;; (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program. If not, see . (use-modules (srfi srfi-1) (srfi srfi-26) (ice-9 match) (ice-9 ftw) (ice-9 pretty-print)) ;;; ;;; Tarjan's strongly connected components algorithm ;;; ;;; Robert Tarjan, Depth-first search and linear graph algorithms. ;;; SIAM Journal on Computing, 1(2):146-160, 1972. ;;; ;;; ;;; vertices is the list of vertices, which may be any objects that ;;; can be distinguished using 'equal?'. ;;; ;;; edges is the list of edges, where each edge is a pair (w . v) ;;; representing the directed edge w => v, for vertices w and v. ;;; ;;; The return value is a list of the strongly-connected components, ;;; where each strongly-connected component (SCC) is represented as a ;;; list of the vertices it contains. The returned SCCs are sorted in ;;; topological order. ;;; (define (strongly-connected-components vertices edges) (define size (length vertices)) (define vs (iota size)) (define lookup (let ((t (make-hash-table size))) (for-each (cut hash-set! t <> <>) vertices vs) (cut hash-ref t <>))) (define name (let ((t (make-vector size #f))) (for-each (cut vector-set! t <> <>) vs vertices) (cut vector-ref t <>))) (define (vector-update! v i f) (vector-set! v i (f (vector-ref v i)))) (define (compose f g) (lambda (x) (f (g x)))) (define successors (let ((t (make-vector size '()))) (for-each (lambda (v w) (vector-update! t v (cut cons w <>))) (map (compose lookup car) edges) (map (compose lookup cdr) edges)) (cut vector-ref t <>))) (define new-index (let ((i -1)) (lambda () (set! i (+ i 1)) i))) (define index-table (make-vector size #f)) (define index (cut vector-ref index-table <>)) (define set-index! (cut vector-set! index-table <> <>)) (define lowlink-table (make-vector size size)) (define lowlink (cut vector-ref lowlink-table <>)) (define (update-lowlink! v x) (if v (vector-update! lowlink-table v (cut min x <>)))) (define done-table (make-bitvector size #f)) (define done? (cut bitvector-ref done-table <>)) (define done! (cut bitvector-set! done-table <> #t)) (define results '()) (define pending '()) (define (finalize! v) (let loop ((names '()) (p pending)) (done! (car p)) (cond ((eqv? v (car p)) (set! pending (cdr p)) (set! results (cons (cons (name v) names) results))) (else (loop (cons (name (car p)) names) (cdr p)))))) (let loop ((v #f) (ws vs) (stack '())) (cond ((pair? ws) (let ((w (car ws))) (cond ((index w) => (lambda (wi) (if (not (done? w)) (update-lowlink! v wi)) (loop v (cdr ws) stack))) (else (let ((wi (new-index))) (set-index! w wi) (update-lowlink! w wi) (set! pending (cons w pending)) (loop w (successors w) (cons (cons v (cdr ws)) stack))))))) ((pair? stack) (if (and v (= (index v) (lowlink v))) (finalize! v)) (update-lowlink! (caar stack) (lowlink v)) (loop (caar stack) (cdar stack) (cdr stack))) (else results)))) (chdir "gnu/packages") (define files (scandir "." (cut string-suffix? ".scm" <>))) (define headers (map (cut call-with-input-file <> read) files)) (define modules (filter-map (lambda (header) (match header (('define-module ('gnu 'packages name) . _) name) (('define-module module-name . _) (format (current-warning-port) "Warning: found unexpected module name ~S in gnu/packages/*.scm~%" module-name) #f))) headers)) (define dependencies (append-map (lambda (header) (match header (('define-module ('gnu 'packages module) . rest) (let loop ((rest rest) (deps '())) (match rest (() deps) ((#:use-module ('gnu 'packages name) . rest) (loop rest `((,module . ,name) . ,deps))) ((#:use-module (('gnu 'packages name) . _) . rest) (loop rest `((,module . ,name) . ,deps))) ((#:use-module _ . rest) (loop rest deps)) ((#:export _ . rest) (loop rest deps)) ((#:autoload _ _ . rest) (loop rest deps))))) (('define-module module-name . _) '()))) headers)) (define sccs (strongly-connected-components modules dependencies)) (define (non-trivial? scc) (not (= 1 (length scc)))) (define non-trivial-sccs (filter non-trivial? sccs)) (unless (null? non-trivial-sccs) (display "Found the following non-trivial strongly-connected components:") (newline) (for-each (lambda (scc) (pretty-print scc) (newline)) non-trivial-sccs)) (define (edges-within vs) (filter (match-lambda ((a . b) (and (member a vs) (member b vs)))) dependencies)) (define (edges-involving vs) (filter (match-lambda ((a . b) (or (member a vs) (member b vs)))) dependencies)) (define (edges-from vs) (filter (match-lambda ((a . b) (member a vs))) dependencies)) (define (edges-to vs) (filter (match-lambda ((a . b) (member b vs))) dependencies)) (define (module-label module) (symbol->string module)) (define* (write-edges-dot edges #:optional (port (current-output-port))) (display "digraph {\n" port) (for-each (match-lambda ((a . b) (format port " ~S -> ~S;\n" (module-label a) (module-label b)))) edges) (display "}\n" port)) (define* (write-scc-dot scc #:optional (port (current-output-port))) (write-edges-dot (edges-within scc) port)) --=-=-= Content-Type: text/plain -- Disinformation flourishes because many people care deeply about injustice but very few check the facts. Ask me about . --=-=-=--