From mboxrd@z Thu Jan 1 00:00:00 1970 From: mhw@netris.org Subject: bug#18247: Cyclic dependencies in (gnu package *) modules Date: Mon, 11 Aug 2014 16:49:36 -0400 Message-ID: <87a97abvkv.fsf@netris.org> References: <87egwmbxln.fsf@netris.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:43870) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XGwXj-0002Jz-4k for bug-guix@gnu.org; Mon, 11 Aug 2014 16:50:18 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XGwXb-0004m0-L7 for bug-guix@gnu.org; Mon, 11 Aug 2014 16:50:11 -0400 Received: from debbugs.gnu.org ([140.186.70.43]:32771) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XGwXb-0004lQ-H8 for bug-guix@gnu.org; Mon, 11 Aug 2014 16:50:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1XGwXa-0006ys-Q2 for bug-guix@gnu.org; Mon, 11 Aug 2014 16:50:02 -0400 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <87egwmbxln.fsf@netris.org> (mhw@netris.org's message of "Mon, 11 Aug 2014 16:05:56 -0400") List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org To: 18247@debbugs.gnu.org --=-=-= Content-Type: text/plain I hacked up the following Guile script to automatically find cyclic dependencies in (gnu packages *). It must be run from Guix's top-level source directory. Mark --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=find-cycles.scm Content-Description: Script to find cyclic dependencies in guix package modules (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 name0 name* ...) . _) `(gnu packages ,name0 ,@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 module . rest) (let loop ((rest rest) (deps '())) (match rest (() deps) ((#:use-module ('gnu 'packages name0 name* ...) . rest) (loop rest `((,module . (gnu packages ,name0 ,@name*)) . ,deps))) ((#:use-module (('gnu 'packagess name0 name* ...) . _) . rest) (loop rest `((,module . (gnu packages ,name0 ,@name*)) . ,deps))) ((#:use-module _ . rest) (loop rest deps)) ((#:export _ . rest) (loop rest deps)) ((#:autoload _ _ . rest) (loop rest deps))))))) 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 (zero? (length non-trivial-sccs)) (display "Found the following non-trivial strongly-connected components:") (newline) (for-each (lambda (scc) (pretty-print scc) (newline)) non-trivial-sccs)) --=-=-=--