blob: 6bda191751be2ae35c796a7619a2abfe3ad94546 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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
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
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
120
121
122
123
124
125
126
|
;;; Commentary:
;;;
;;; For a given module in the project, finds all other modules who uses that
;;; module, and break it down per symbol.
;;;
;;; Code:
(define-module (scripts module-dependants)
:use-module (hnh util)
:use-module (hnh util path)
:use-module (srfi srfi-1)
:use-module (srfi srfi-71)
:use-module (ice-9 ftw)
:use-module (ice-9 curried-definitions)
:use-module (ice-9 format)
:use-module (texinfo string-utils)
:use-module (hnh module-introspection)
:use-module ((hnh module-introspection static-util) :select (get-forms))
:export (main))
(define %summary "Print all modules which depend on module specified in target file.")
(define %synopsis "module-dependants TARGET-FILE")
(define cstat (make-object-property))
(define (find-all-files-under directory)
(file-system-fold
;; enter?
(lambda (path stat result) #t)
;; leaf
(lambda (path stat result)
(set! (cstat path) stat)
(cons path result))
;; down
(lambda (path stat result)
(set! (cstat path) stat)
(cons path result))
;; up
(lambda (path state result) result)
;; skip
(lambda (path stat result) result)
;; error
(lambda (path stat errno result) result)
'() directory))
(define (regular-file? filename)
(eq? 'regular (stat:type (cstat filename))))
;; Does @var{filename} have the extension @var{ext}?
(define ((filename-extension? ext) filename)
(string=? ext (filename-extension filename)))
(define (main . args)
(define target-file (realpath (car args)))
(define target-forms
(reverse (call-with-input-file target-file get-forms)))
(define target-module
(find-module-declaration target-forms))
;; (define target-symbols (unique-symbols target-forms))
;; (write target-module) (newline)
(define edges
(concatenate
(map (lambda (file)
(catch #t
(lambda ()
(define forms (call-with-input-file file get-forms))
(define module (and=> (-> forms find-module-declaration) resolve-module))
(define source-symbols (unique-symbols forms))
(when module
(awhen (find (lambda (module)
(equal? target-module
(module-name module)))
(module-uses module))
(let ((module-symbols (module-map (lambda (key value) key) it)))
;; (display " ")
(map (lambda (symb)
(cons file symb))
(lset-intersection eq? source-symbols module-symbols))
))))
;; TODO many of these errors are due to the 'prefix and 'postfix
;; read options being set for modules which expect them to be off.
(lambda (err proc fmt args data)
(format (current-error-port)
"ERROR when reading ~a: ~a in ~a: ~?~%" file err proc fmt args)
'())))
(delete target-file
(filter (filename-extension? "scm")
(filter regular-file?
(append-map (lambda (module-dir)
(find-all-files-under module-dir))
%load-path)))))))
(define file-uses (make-hash-table))
(define symbol-used-by (make-hash-table))
(for-each (lambda (edge)
(hashq-set! symbol-used-by (cdr edge)
(cons (car edge) (hashq-ref symbol-used-by (cdr edge) '())))
(hash-set! file-uses (car edge)
(cons (cdr edge) (hash-ref file-uses (car edge) '()))))
edges)
(for-each (lambda (pair)
(let ((symb files (car+cdr pair)))
(display (center-string (format #f " ~a (~a uses)" symb (length files))
80 #\= #\=))
(newline)
(for-each (lambda (file) (format #t "• ~a~%" file)) files)
(newline)))
(sort*
(hash-map->list cons symbol-used-by)
string< (compose symbol->string car)))
(display (center-string " Unused (except possibly internally) " 80 #\= #\=)) (newline)
(for-each (lambda (symb) (format #t "• ~a~%" symb))
(lset-difference
eqv?
(module-map (lambda (k _) k) (resolve-interface target-module) )
(hash-map->list (lambda (k _) k) symbol-used-by)))
)
|
