36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
-
+
-
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
+
+
|
(define unituses-rx (regexp "^\\(declare \\((unit|uses) ([^\\(\\)]+)\\).*"))
(define (print-err . data)
(with-output-to-port (current-error-port)
(lambda ()
(apply print data))))
(define (process-file fname)
(define (process-file ignores fname)
(with-input-from-file fname
(lambda ()
(let loop ((modname "DUMMYMOD"))
(let* ((inl (read-line)))
(if (eof-object? inl)
#t
(match (string-search unituses-rx inl)
((_ dtype unitname)
(if (equal? dtype "unit")
(loop unitname)
(begin
(if (equal? dtype "uses")
(if (not (member modname '("DUMMYMOD")))
(if (not (or (member modname '("DUMMYMOD"))
(member modname ignores)
(member unitname ignores)))
(print " \""unitname"\" -> \""modname"\";"))
(print-err "ERROR: bad declare line \""inl"\""))
(loop modname))))
(else
(loop modname)))))))))
(define (main)
(match (command-line-arguments)
(("todot" . files)
(print-err "Making graph for files: " (string-intersperse files ", "))
(print "digraph uses_unit {")
(for-each
(lambda (fname)
(print "// Filename: "fname)
(process-file fname))
files)
(print "}"))
(("todot" ignoreunits . files)
(let* ((ignores (string-split ignoreunits ",")))
(print-err "Making graph for files: " (string-intersperse files ", "))
(print "digraph uses_unit {")
(for-each
(lambda (fname)
(print "// Filename: "fname)
(process-file ignores fname))
files)
(print "}")))
(else
(print-err "Usage: plot-uses file1.scm ..."))))
(print-err "Usage: plot-uses u1,u2... file1.scm ...")
(print-err " where u1,u2... are units to ignore and file1.scm... are the files to process."))))
(main)
)
;;
;; ;; Gather the usages
;; (print "digraph G {")
|