Re: Module dependency graph

[thi]

   From: Keisuke Nishida <address@hidden>
   Date: Sat, 24 Mar 2001 14:48:59 -0500

   Well, I'm not familiar with Guile Scheme as a scripting language,
   so... ;)

it's alright.  the caffeine hadn't kicked in yet, the perl was
invigorating but not bitter.

   Dotted lines are drawn as follows:

     "foo" -> "bar" [style=dotted];

   Available styles are "bold", "dotted", and "filled".

cool.  see below for revision 1.2 ... i commented out some of the graph
style stuff, figuring that people will munge those to taste anyway.

thi


________________________________________
#!/bin/sh
exec guile -s $0 "$@"                           # -*- scheme -*-
!#
;;; ID: use2dot.scm,v 1.2 2001/03/26 10:46:55 ttn Exp
;;;
;;; Copyright (C) 2001 Thien-Thi Nguyen
;;; This program is part of ttn-do, released under GNU GPL v2 with ABSOLUTELY
;;; NO WARRANTY.  See http://www.gnu.org/copyleft/gpl.txt for details.

;;; Commentary:

;; Usage: use2dot [OPTIONS] [FILE ...]
;; Display to stdout a DOT specification that describes module dependencies
;; in FILEs.  If FILE is omitted, use the current directory.  For directories,
;; recursively process all files ending in ".scm".
;;
;; A top-level `use-modules' form or a `:use-module' `define-module'-component
;; results in a "solid" style edge.
;;
;; An `:autoload' `define-module'-component results in a "dotted" style edge
;; with label "N" indicating that N names are responsible for triggering the
;; autoload.
;;
;; A top-level `load' or `primitive-load' form results in a a "bold" style
;; edge to a node named with either the file name if the `load' argument is a
;; string, or "[computed in FILE]" otherwise.
;;
;; Options:
;; --default-module MOD  -- Set MOD as the default module (for top-level
;;                          `use-modules' forms that do not follow some
;;                          `define-module' form in a file).  MOD should be
;;                          be a list or `#f', in which case such top-level
;;                          `use-modules' forms are effectively ignored.
;;                          Default value: `(guile)'.
;;
;; TODO
;; - add `--load-synonyms' option
;; - add `--ignore-module' option
;; - handle arbitrary command-line key/value configuration
;; - snarf general dot-format generation into ttn-pers-scheme
;; - snarf grok into GUMM

;;; Code:

(use-modules (ice-9 regex))
(use-modules (ttn echo) (ttn ftw) (ttn eformat) (ttn stringutils))

(activate-eformat)

(define ec ";")                         ; end command (here to pacify emacs)
(define default-module '(guile))

(define (q s)                           ; quote
  #["$s"])

(define (vv pair)                       ; var=val
  #[$(lambda () (car pair))=$(lambda () (cdr pair))])

(define (spew module use . etc)
  (and module
       (let ((etc-spec (if (null? etc)
                           ""
                           #[ \[$(lambda () (mapconcat vv etc ","))\]])))
         (echo #[  "${module}" -> "${use}"${etc-spec}$ec]))))

(define (header)
  (echo "digraph use2dot {")
  (for-each (lambda (s) (echo #[  $s$ec]))
            (map vv `((label . ,(q "Guile Module Dependencies"))
                      ;(rankdir . LR)
                      ;(size . ,(q "7.5,10"))
                      (ratio . fill)
                      ;(nodesep . ,(q "0.05"))
                      ))))

(define (grok filename)
  (let* ((p (open-file filename "r"))
         (next (lambda () (read p)))
         (curmod #f))
    (let loop ((form (next)))
      (cond ((eof-object? form))
            ((not (list? form)) (loop (next)))
            (else (case (car form)
                    ((define-module)
                     (let ((module (cadr form)))
                       (set! curmod module)
                       (let loop ((ls form))
                         (or (null? ls)
                             (case (car ls)
                               ((:use-module)
                                (spew module (cadr ls))
                                (loop (cddr ls)))
                               ((:autoload)
                                (spew module (cadr ls)
                                      '(style . dotted)
                                      '(fontsize . 5)
                                      (let ((len (length (caddr ls))))
                                        `(label . ,#["$len"])))
                                (loop (cdddr ls)))
                               (else (loop (cdr ls))))))))
                    ((use-modules)
                     (for-each (lambda (use)
                                 (spew (or curmod default-module) use))
                               (cdr form)))
                    ((load primitive-load)
                     (spew (or curmod default-module)
                           (let ((file (cadr form)))
                             (if (string? file)
                                 file
                                 #[\[computed in $filename\]]))
                           '(style . bold))))
                  (loop (next)))))))

(define (body files)
  (for-each (lambda (file)
              (ftw file (lambda (filename statinfo flag)
                          (and (eq? 'regular flag)
                               (string-match "\\.scm$" filename)
                               (not (string-match "autoload" filename))
                               (grok filename))
                          #t)))
            (cond ((null? files) '("."))
                  (else files))))

(define (footer)
  (echo "}"))

(define (main)
  (header)
  (let ((cline (cdr (command-line))))
    (cond ((and (not (null? cline))
                (< 1 (length cline))
                (string=? "--default-module" (car cline)))
           (set! default-module (with-input-from-string (cadr cline)
                                  (lambda () (read))))
           (set! cline (cddr cline))))
    (body cline))
  (footer))

(exit (main))

(deactivate-eformat)

;;; use2dot.scm,v1.2 ends here