2 # aside from this initial boilerplate, this is actually -*- scheme -*- code
3 main
='(module-ref (resolve-module '\''(scripts frisk)) '\'main
')'
4 exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
6 ;;; frisk
--- Grok the module interfaces of a body of files
8 ;; Copyright
(C
) 2002 Free Software Foundation
, Inc.
10 ;; This program is free software
; you can redistribute it and
/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation
; either version
2, or
13 ;; (at your option
) any later version.
15 ;; This program is distributed
in the hope that it will be useful
,
16 ;; but WITHOUT ANY WARRANTY
; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License
for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this software
; see the
file COPYING. If not
, write to
22 ;; the Free Software Foundation
, Inc.
, 59 Temple Place
, Suite
330,
23 ;; Boston
, MA
02111-1307 USA
25 ;;; Author
: Thien-Thi Nguyen
<ttn@gnu.org
>
29 ;; Usage
: frisk
[options
] file ...
31 ;; Analyze FILE... module interfaces
in aggregate
(as a
"body"),
32 ;; and display a summary. Modules that are
`define-module'd are
33 ;; considered "internal" (and those not, "external"). When module X
34 ;; uses module Y, X is said to be "(a) downstream of" Y, and Y is
35 ;; "(an) upstream of" X.
37 ;; Normally, the summary displays external modules and their internal
38 ;; downstreams, as this is the usual question asked by a body. There
39 ;; are several options that modify this output.
41 ;; -u, --upstream show upstream edges
42 ;; -d, --downstream show downstream edges (default)
43 ;; -i, --internal show internal modules
44 ;; -x, --external show external modules (default)
46 ;; If given both `upstream
' and `downstream' options
("frisk -ud"), the
47 ;; output is formatted
: "C MODULE --- UP-LS --- DOWN-LS", where C is
48 ;; either
`i' or `x
', and each element of UP-LS and DOWN-LS is (TYPE
51 ;; In all other cases, the "C MODULE" occupies its own line, and
52 ;; subsequent lines list the up- or downstream edges, respectively,
53 ;; indented by some non-zero amount of whitespace.
55 ;; Top-level `use-modules' (or
`load' or 'primitive-load') forms in a
56 ;; file that do not follow a `define-module
' result an edge where the
57 ;; downstream is the "default module", normally `(guile-user)'. This
58 ;; can be
set to another value by using
:
60 ;; -m, --default-module MOD
set MOD as the default module
62 ;; Usage from a Scheme Program
: (use-modules
(scripts frisk
))
64 ;; Module
export list
:
66 ;; (make-frisker . options
) => (lambda
(files
) ...
) [see below
]
67 ;; (mod-up-ls module
) => upstream edges
68 ;; (mod-down-ls module
) => downstream edges
69 ;; (mod-int? module
) => is the module internal?
70 ;; (edge-type edge
) => symbol
: {regular
,autoload
,computed
}
71 ;; (edge-up edge
) => upstream module
72 ;; (edge-down edge
) => downstream module
74 ;; OPTIONS is an alist. Recognized keys are
:
77 ;; `make-frisker' returns a procedure that takes a list of files, the
78 ;; FRISKER. FRISKER returns a closure, REPORT, that takes one of the
80 ;; modules -- entire list of modules
81 ;; internal -- list of internal modules
82 ;; external -- list of external modules
83 ;; i-up -- list of modules upstream of internal modules
84 ;; x-up -- list of modules upstream of external modules
85 ;; i-down -- list of modules downstream of internal modules
86 ;; x-down -- list of modules downstream of external modules
87 ;; edges -- list of edges
88 ;; Note that `x-up
' should always be null, since by (lack of!)
89 ;; definition, we only know external modules by reference.
91 ;; The module and edge objects managed by REPORT can be examined in
92 ;; detail by using the other (self-explanatory) procedures. Be careful
93 ;; not to confuse a freshly consed list of symbols, like `(a b c)' with
94 ;; the module
`(a b c)'. If you want to find the module by that name,
95 ;; try: (cond ((member '(a b c) (REPORT 'modules)) => car)).
97 ;; TODO: Make "frisk -ud" output less ugly.
98 ;; Consider default module as internal; add option to invert.
99 ;; Support `edge-misc
' data.
103 (define-module (scripts frisk)
104 :autoload (ice-9 getopt-long) (getopt-long)
105 :use-module ((srfi srfi-1) :select (filter remove))
108 mod-up-ls mod-down-ls mod-int?
109 edge-type edge-up edge-down))
111 (define *default-module* '(guile-user
))
113 (define
(grok-proc default-module note-use
!)
115 (let* ((p
(open-file filename
"r"))
116 (next
(lambda
() (read p
)))
117 (ferret
(lambda
(use
) ;;; handle
"((foo bar) :select ...)"
118 (let ((maybe
(car use
)))
123 (let loop
((form
(next
)))
124 (cond
((eof-object? form
))
125 ((not
(list? form
)) (loop
(next
)))
126 (else (case (car form
)
128 (let ((module
(cadr form
)))
130 (note-use
! 'def module #f)
131 (let loop ((ls form))
135 (note-use! 'regular module
(ferret
(cadr
ls)))
138 (note-use
! 'autoload module (cadr ls))
140 (else (loop (cdr ls))))))))
142 (for-each (lambda (use)
144 (or curmod default-module
)
147 ((load primitive-load
)
149 (or curmod default-module)
150 (let ((file (cadr form)))
153 (format #f "[computed in ~A]"
157 (define up-ls (make-object-property)) ; list
158 (define dn-ls (make-object-property)) ; list
159 (define int? (make-object-property)) ; defined via `define-module'
161 (define mod-up-ls up-ls
)
162 (define mod-down-ls dn-ls
)
163 (define mod-int? int?
)
165 (define
(i-or-x module
)
166 (if (int? module
) 'i 'x
))
168 (define edge-type
(make-object-property
)) ; symbol
170 (define
(make-edge
type up down
)
171 (let ((new
(cons up down
)))
172 (set! (edge-type new
) type)
176 (define edge-down cdr
)
178 (define
(up-ls
+! m new
) (set! (up-ls m
) (cons new
(up-ls m
))))
179 (define
(dn-ls
+! m new
) (set! (dn-ls m
) (cons new
(dn-ls m
))))
181 (define
(make-body alist
)
183 (assq-ref alist key
)))
185 (define
(scan default-module files
)
186 (let* ((modules
(list
))
188 (intern
(lambda
(module
)
189 (cond
((member module modules
) => car
)
190 (else (set! (up-ls module
) (list
))
191 (set! (dn-ls module
) (list
))
192 (set! modules
(cons module modules
))
194 (grok
(grok-proc default-module
196 (let ((d
(intern d
)))
199 (let* ((u (intern u))
200 (edge (make-edge type u d)))
201 (set! edges (cons edge edges))
203 (dn-ls+! u edge))))))))
204 (for-each grok files)
206 `((modules . ,modules)
207 (internal . ,(filter int? modules))
208 (external . ,(remove int? modules))
209 (i-up . ,(filter int? (map edge-down edges)))
210 (x-up . ,(remove int? (map edge-down edges)))
211 (i-down . ,(filter int? (map edge-up edges)))
212 (x-down . ,(remove int? (map edge-up edges)))
215 (define (make-frisker . options)
216 (let ((default-module (or (assq-ref options 'default-module
)
219 (scan default-module files
))))
221 (define
(dump-updown modules
)
222 (for-each
(lambda
(m
)
223 (format
#t "~A ~A --- ~A --- ~A\n"
226 (cons
(edge-type edge
)
230 (cons
(edge-type edge
)
235 (define
(dump-up modules
)
236 (for-each
(lambda
(m
)
237 (format
#t "~A ~A\n" (i-or-x m) m)
238 (for-each
(lambda
(edge
)
239 (format
#t "\t\t\t ~A\t~A\n"
240 (edge-type edge
) (edge-up edge
)))
244 (define
(dump-down modules
)
245 (for-each
(lambda
(m
)
246 (format
#t "~A ~A\n" (i-or-x m) m)
247 (for-each
(lambda
(edge
)
248 (format
#t "\t\t\t ~A\t~A\n"
249 (edge-type edge
) (edge-down edge
)))
253 (define
(frisk . args
)
254 (let* ((parsed-opts
(getopt-long
255 (cons
"frisk" args
) ;;; kludge
256 '((upstream (single-char #\u))
257 (downstream (single-char #\d))
258 (internal (single-char #\i))
259 (external (single-char #\x))
263 (=u (option-ref parsed-opts 'upstream
#f))
264 (=d
(option-ref parsed-opts
'downstream #f))
265 (=i (option-ref parsed-opts 'internal
#f))
266 (=x
(option-ref parsed-opts
'external #f))
267 (files (option-ref parsed-opts '() (list
)))
268 (report
((make-frisker
270 . ,(option-ref parsed-opts 'default-module
273 (modules (report 'modules))
274 (internal (report 'internal))
275 (external (report 'external))
276 (edges (report 'edges)))
277 (format #t "~A ~A, ~A ~A (~A ~A, ~A ~A), ~A ~A\n\n"
278 (length files) "files"
279 (length modules) "modules"
280 (length internal) "internal"
281 (length external) "external"
282 (length edges) "edges")
283 ((cond ((and =u =d) dump-updown)
286 (cond ((and =i =x) modules)