blob: 212a28c886d568c238a1513db7b6761c87dacac0 (
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
|
#!/usr/bin/guile \
-e main -s
!#
;;; 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-dir (string-append
(dirname (dirname (current-filename)))
"/module"))
(add-to-load-path module-dir)
(add-to-load-path (dirname (current-filename)))
(use-modules (hnh util)
(srfi srfi-1)
(ice-9 ftw)
(texinfo string-utils)
(module-introspection))
(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))))
(define (filename-extension ext)
(let ((re (make-regexp (string-append ((@ (texinfo string-utils)
escape-special-chars)
ext "^$[]()*." #\\)
"$") regexp/icase)))
(lambda (filename) (regexp-exec re filename))))
(define (main args)
;; TODO this needs to be an absolute filename, for the remove below to work
;; Fix this once `realpath' is written
(define target-file (cadr 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)
(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))
)))
)
(delete target-file
(filter (filename-extension ".scm")
(filter regular-file?
(find-all-files-under module-dir)))))))
(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)
(hash-for-each (lambda (symb files)
(display (center-string (format #f " ~a (~a uses)" symb (length files))
80 #\= #\=)) (newline)
(for-each (lambda (file) (format #t "• ~a~%" file)) files))
symbol-used-by)
(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)))
)
|