26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
26
27
28
29
30
31
32
33
34
35
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
|
+
+
+
+
+
-
+
+
+
-
-
+
+
|
(lambda ()
(apply print args))))
(define (mofiles-adjust->dot-o inf)
(regex-case
inf
("^.*mod$" _ (conc "mofiles/"inf".o"))
("ods" _ (conc "mofiles/"inf".o"))
("pgdb" _ (conc "cgisetup/models/"inf".o"))
(else (conc inf".o"))))
(define (hh-push ht k1 val)
(hash-table-set! ht k1 (cons val (hash-table-ref/default ht k1 '()))))
(define (compunit targfname files)
(let* ((unitdata (make-hash-table))
(moduledata (make-hash-table))
(incldata (make-hash-table))
(filesdata (make-hash-table))
(unitdec (regexp "^\\(declare\\s+\\(unit\\s+([^\\s]+)\\)\\)"))
(unituse (regexp "^\\(declare\\s+\\(uses\\s+([^\\s]+)\\)\\)"))
(moduledec (regexp "^\\(module\\s+([\\s]+)"))
(moduledec (regexp "^\\(module\\s+([\\S]+).*"))
(importuse (regexp "^\\(import\\s+(.*)\\)")) ;; captures string of imports (one line)
(dotport (open-output-file (conc targfname ".dot")))
(incdotport (open-output-file (conc targfname"-inc.dot")))
(incport (open-output-file (conc targfname ".inc")))
)
(portprint dotport "digraph usedeps {")
(portprint dotport "digraph usedeps {")
(portprint incport "# To regenerate this file do:
(portprint incdotport "digraph usedeps {")
(portprint incport "# To regenerate this file do:
# (cd utils/;ck52 csc gendeps.scm) && ./utils/gendeps allunits *scm
# cp allunits.inc build.inc
#
")
(for-each
(lambda (fname)
(let* ((sname (string-substitute "\\.scm$" "" fname)))
|
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(regex-case
inl
(unitdec (_ unitname)
(if (equal? sname unitname) ;; good if same
(if (not (hash-table-exists? unitdata unitname))
(hash-table-set! unitdata unitname (make-hash-table)))))
(unituse (_ usingname)
(portprint dotport "\""usingname"\" -> \""sname"\"")
(portprint dotport "\""usingname"\" -> \""sname"\""))
(portprint incport
(if (or (string-search ".import$" sname)
(string-search ".import$" usingname))
"# "
"")
(mofiles-adjust->dot-o sname)" : "
(mofiles-adjust->dot-o usingname)))
;; (moduledec (_ modname) (print "Module: " modname))
;; (importuse (_ importname) (print "Imports: " importname))
(moduledec (_ modname)
(print "Found module "modname)
(hash-table-set! moduledata modname sname))
(importuse (_ importname)
(print "Found import "importname)
(hh-push incldata importname sname))
(else #f))
(loop (read-line)))))))))
files)
(hash-table-for-each
incldata
(lambda (impname snames)
(for-each
(lambda (sname)
(if (hash-table-exists? moduledata impname)
(make-inc-entry incport incdotport sname impname)
(print "No module file found for import " impname)
))
snames)))
(portprint dotport "}")
(portprint incdotport "}")
(close-output-port dotport)
(close-output-port incport)))
(close-output-port incport)
(close-output-port incdotport)))
(define (make-inc-entry incport incdotport sname impname)
(let* ((leftname (mofiles-adjust->dot-o sname))
(rightname (mofiles-adjust->dot-o impname)))
(portprint incport
(if (or (string-search ".import$" sname)
(string-search ".import$" impname))
"# "
"")
leftname" : "rightname)
(portprint incdotport "\""impname"\" -> \""sname"\"")))
;; seen is hash of seen functions
(define usage "Usage: gendeps targfile files...
")
(define (main)
|