From 1e7f6318acd8b75235f513088a58158df2366795 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Fri, 23 Sep 2022 22:15:02 +0200
Subject: Cleanup in module-{dependants,imports}.

---
 module/scripts/module-dependants.scm | 59 +++++++++++++++++++-----------------
 module/scripts/module-imports.scm    |  4 +--
 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)
-- 
cgit v1.2.3