#!/bin/sh # aside from this initial boilerplate, this is actually -*- scheme -*- code main='(module-ref (resolve-module '\''(scripts frisk)) '\'main')' exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" !# ;;; frisk --- Grok the module interfaces of a body of files ;; Copyright (C) 2002 Free Software Foundation, Inc. ;; ;; 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 2, 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 software; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, ;; Boston, MA 02111-1307 USA ;;; Author: Thien-Thi Nguyen ;;; Commentary: ;; Usage: frisk [options] file ... ;; ;; Analyze FILE... module interfaces in aggregate (as a "body"), ;; and display a summary. Modules that are `define-module'd are ;; considered "internal" (and those not, "external"). When module X ;; uses module Y, X is said to be "(a) downstream of" Y, and Y is ;; "(an) upstream of" X. ;; ;; Normally, the summary displays external modules and their internal ;; downstreams, as this is the usual question asked by a body. There ;; are several options that modify this output. ;; ;; -u, --upstream show upstream edges ;; -d, --downstream show downstream edges (default) ;; -i, --internal show internal modules ;; -x, --external show external modules (default) ;; ;; If given both `upstream' and `downstream' options ("frisk -ud"), the ;; output is formatted: "C MODULE --- UP-LS --- DOWN-LS", where C is ;; either `i' or `x', and each element of UP-LS and DOWN-LS is (TYPE ;; MODULE-NAME ...). ;; ;; In all other cases, the "C MODULE" occupies its own line, and ;; subsequent lines list the up- or downstream edges, respectively, ;; indented by some non-zero amount of whitespace. ;; ;; Top-level `use-modules' (or `load' or 'primitive-load') forms in a ;; file that do not follow a `define-module' result an edge where the ;; downstream is the "default module", normally `(guile-user)'. This ;; can be set to another value by using: ;; ;; -m, --default-module MOD set MOD as the default module ;; Usage from a Scheme Program: (use-modules (scripts frisk)) ;; ;; Module export list: ;; (frisk . args) ;; (make-frisker . options) => (lambda (files) ...) [see below] ;; (mod-up-ls module) => upstream edges ;; (mod-dn-ls module) => downstream edges ;; (mod-int? module) => is the module internal? ;; (edge-type edge) => symbol: {regular,autoload,computed} ;; (edge-up edge) => upstream module ;; (edge-down edge) => downstream module ;; ;; OPTIONS is an alist. Recognized keys are: ;; default-module ;; ;; `make-frisker' returns a procedure that takes a list of files, the ;; FRISKER. FRISKER returns a closure, REPORT, that takes one of the ;; keys: ;; modules -- entire list of modules ;; internal -- list of internal modules ;; external -- list of external modules ;; i-up -- list of modules upstream of internal modules ;; x-up -- list of modules upstream of external modules ;; i-down -- list of modules downstream of internal modules ;; x-down -- list of modules downstream of external modules ;; edges -- list of edges ;; Note that `x-up' should always be null, since by (lack of!) ;; definition, we only know external modules by reference. ;; ;; The module and edge objects managed by REPORT can be examined in ;; detail by using the other (self-explanatory) procedures. Be careful ;; not to confuse a freshly consed list of symbols, like `(a b c)' with ;; the module `(a b c)'. If you want to find the module by that name, ;; try: (cond ((member '(a b c) (REPORT 'modules)) => car)). ;; TODO: Make "frisk -ud" output less ugly. ;; Consider default module as internal; add option to invert. ;; Support `edge-misc' data. ;;; Code: (define-module (scripts frisk) :autoload (ice-9 getopt-long) (getopt-long) :use-module ((srfi srfi-1) :select (filter remove)) :export (frisk make-frisker mod-up-ls mod-down-ls mod-int? edge-type edge-up edge-down)) (define *default-module* '(guile-user)) (define (grok-proc default-module note-use!) (lambda (filename) (let* ((p (open-file filename "r")) (next (lambda () (read p))) (ferret (lambda (use) ;;; handle "((foo bar) :select ...)" (let ((maybe (car use))) (if (list? maybe) maybe use)))) (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) (note-use! 'def module #f) (let loop ((ls form)) (or (null? ls) (case (car ls) ((:use-module) (note-use! 'regular module (ferret (cadr ls))) (loop (cddr ls))) ((:autoload) (note-use! 'autoload module (cadr ls)) (loop (cdddr ls))) (else (loop (cdr ls)))))))) ((use-modules) (for-each (lambda (use) (note-use! 'regular (or curmod default-module) (ferret use))) (cdr form))) ((load primitive-load) (note-use! 'computed (or curmod default-module) (let ((file (cadr form))) (if (string? file) file (format #f "[computed in ~A]" filename)))))) (loop (next)))))))) (define up-ls (make-object-property)) ; list (define dn-ls (make-object-property)) ; list (define int? (make-object-property)) ; defined via `define-module' (define mod-up-ls up-ls) (define mod-down-ls dn-ls) (define mod-int? int?) (define (i-or-x module) (if (int? module) 'i 'x)) (define edge-type (make-object-property)) ; symbol (define (make-edge type up down) (let ((new (cons up down))) (set! (edge-type new) type) new)) (define edge-up car) (define edge-down cdr) (define (up-ls+! m new) (set! (up-ls m) (cons new (up-ls m)))) (define (dn-ls+! m new) (set! (dn-ls m) (cons new (dn-ls m)))) (define (make-body alist) (lambda (key) (assq-ref alist key))) (define (scan default-module files) (let* ((modules (list)) (edges (list)) (intern (lambda (module) (cond ((member module modules) => car) (else (set! (up-ls module) (list)) (set! (dn-ls module) (list)) (set! modules (cons module modules)) module)))) (grok (grok-proc default-module (lambda (type d u) (let ((d (intern d))) (if (eq? type 'def) (set! (int? d) #t) (let* ((u (intern u)) (edge (make-edge type u d))) (set! edges (cons edge edges)) (up-ls+! d edge) (dn-ls+! u edge)))))))) (for-each grok files) (make-body `((modules . ,modules) (internal . ,(filter int? modules)) (external . ,(remove int? modules)) (i-up . ,(filter int? (map edge-down edges))) (x-up . ,(remove int? (map edge-down edges))) (i-down . ,(filter int? (map edge-up edges))) (x-down . ,(remove int? (map edge-up edges))) (edges . ,edges))))) (define (make-frisker . options) (let ((default-module (or (assq-ref options 'default-module) *default-module*))) (lambda (files) (scan default-module files)))) (define (dump-updown modules) (for-each (lambda (m) (format #t "~A ~A --- ~A --- ~A\n" (i-or-x m) m (map (lambda (edge) (cons (edge-type edge) (edge-up edge))) (up-ls m)) (map (lambda (edge) (cons (edge-type edge) (edge-down edge))) (dn-ls m)))) modules)) (define (dump-up modules) (for-each (lambda (m) (format #t "~A ~A\n" (i-or-x m) m) (for-each (lambda (edge) (format #t "\t\t\t ~A\t~A\n" (edge-type edge) (edge-up edge))) (up-ls m))) modules)) (define (dump-down modules) (for-each (lambda (m) (format #t "~A ~A\n" (i-or-x m) m) (for-each (lambda (edge) (format #t "\t\t\t ~A\t~A\n" (edge-type edge) (edge-down edge))) (dn-ls m))) modules)) (define (frisk . args) (let* ((parsed-opts (getopt-long (cons "frisk" args) ;;; kludge '((upstream (single-char #\u)) (downstream (single-char #\d)) (internal (single-char #\i)) (external (single-char #\x)) (default-module (single-char #\m) (value #t))))) (=u (option-ref parsed-opts 'upstream #f)) (=d (option-ref parsed-opts 'downstream #f)) (=i (option-ref parsed-opts 'internal #f)) (=x (option-ref parsed-opts 'external #f)) (files (option-ref parsed-opts '() (list))) (report ((make-frisker `(default-module . ,(option-ref parsed-opts 'default-module *default-module*))) files)) (modules (report 'modules)) (internal (report 'internal)) (external (report 'external)) (edges (report 'edges))) (format #t "~A ~A, ~A ~A (~A ~A, ~A ~A), ~A ~A\n\n" (length files) "files" (length modules) "modules" (length internal) "internal" (length external) "external" (length edges) "edges") ((cond ((and =u =d) dump-updown) (=u dump-up) (else dump-down)) (cond ((and =i =x) modules) (=i internal) (else external))))) (define main frisk) ;;; frisk ends here