aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-09-23 22:15:02 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2022-09-23 22:23:47 +0200
commit1e7f6318acd8b75235f513088a58158df2366795 (patch)
treea11267745b0e2875ef5e174c76ddd0524120cb68
parentDocument and parameterize peg-to-graph. (diff)
downloadcalp-1e7f6318acd8b75235f513088a58158df2366795.tar.gz
calp-1e7f6318acd8b75235f513088a58158df2366795.tar.xz
Cleanup in module-{dependants,imports}.
-rwxr-xr-xmodule/scripts/module-dependants.scm59
-rwxr-xr-xmodule/scripts/module-imports.scm4
2 files changed, 33 insertions, 30 deletions
diff --git a/module/scripts/module-dependants.scm b/module/scripts/module-dependants.scm
index 630da519..6bda1917 100755
--- a/module/scripts/module-dependants.scm
+++ b/module/scripts/module-dependants.scm
@@ -11,6 +11,8 @@
: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))
@@ -44,12 +46,9 @@
(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))))
+;; Does @var{filename} have the extension @var{ext}?
+(define ((filename-extension? ext) filename)
+ (string=? ext (filename-extension filename)))
(define (main . args)
@@ -64,32 +63,36 @@
(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))
- )))
- )
+ (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 (filename-extension? "scm")
(filter regular-file?
(append-map (lambda (module-dir)
(find-all-files-under module-dir))
- ;; TODO this should be %load-path, but get-forms claims
- ;; some files contains invalid syntax.
- #; %load-path
- '("module")
- )))))))
+ %load-path)))))))
(define file-uses (make-hash-table))
diff --git a/module/scripts/module-imports.scm b/module/scripts/module-imports.scm
index 0639715f..dc7d9a78 100755
--- a/module/scripts/module-imports.scm
+++ b/module/scripts/module-imports.scm
@@ -16,8 +16,7 @@
:export (main)
)
-;; (define %summary "")
-(define %include-in-guild-list #t)
+(define %summary "List imports, and how many are used.")
(define %synopsis "module-imports filename")
;;; Module use high scores
@@ -36,6 +35,7 @@
;; (format #t "~y" (find-module-declaration forms))
;; (format #t "~a~%" symbs)
+ ;; TODO parameterize this to a command line argument
(define skip-list '((guile)
(guile-user)
(srfi srfi-1)