diff options
Diffstat (limited to 'scripts/use2dot/gen-use.scm')
-rwxr-xr-x | scripts/use2dot/gen-use.scm | 36 |
1 files changed, 6 insertions, 30 deletions
diff --git a/scripts/use2dot/gen-use.scm b/scripts/use2dot/gen-use.scm index 02785088..6c621fdd 100755 --- a/scripts/use2dot/gen-use.scm +++ b/scripts/use2dot/gen-use.scm @@ -2,43 +2,19 @@ !# (add-to-load-path (dirname (current-filename))) +(add-to-load-path (dirname (dirname (current-filename)))) (use-modules ((scripts frisk) :select (make-frisker edge-type edge-up edge-down)) (srfi srfi-1) - (ice-9 ftw) - (ice-9 regex) - (ice-9 match) ((graphviz) :prefix gv.) + (all-modules) ) (define scan (make-frisker `(default-module . (calp main)))) -(define re (make-regexp "\\.scm$")) - -(define lst '()) - -(ftw "module" (lambda (filename statinfo flag) - (cond ((and (eq? flag 'regular) - (regexp-exec re filename)) - => (lambda (m) - (set! lst (cons filename lst)) - #t - )) - (else #t)))) - - - -(define files lst) - -(define our-modules - (filter identity - (map (lambda (file) - (match (call-with-input-file file read) - (('define-module (module ...) _ ...) - module) - (_ #f))) - files))) +(define-values (files our-modules) + (all-modules-under-directory "module")) (define graph (gv.digraph "G")) (gv.setv graph "color" "blue") @@ -133,7 +109,7 @@ (for-each (lambda (edge) - (let ((gv-edge (gv.edge graph + (let ((gv-edge (gv.edge graph (format #f "~a" (edge-down edge)) (format #f "~a" (edge-up edge)) ))) @@ -144,7 +120,7 @@ (not (memv (car (edge-down edge)) '(vcomponent calp )))) (gv.setv gv-edge "color" "blue")) )) - (remove-edges '((srfi srfi-1) + (remove-edges '((srfi srfi-1) (srfi srfi-9) (srfi srfi-26) (srfi srfi-41) |