From 656d75af3de53f1f30d34f7a8eb36c6e45fb86d8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 1 Feb 2022 00:49:31 +0100
Subject: Broke module-import script into library component.

---
 scripts/module-imports.scm       | 62 +++++++++-------------------------------
 scripts/module-introspection.scm | 49 +++++++++++++++++++++++++++++++
 2 files changed, 63 insertions(+), 48 deletions(-)
 create mode 100644 scripts/module-introspection.scm

(limited to 'scripts')

diff --git a/scripts/module-imports.scm b/scripts/module-imports.scm
index 5ac1f215..19598172 100755
--- a/scripts/module-imports.scm
+++ b/scripts/module-imports.scm
@@ -12,48 +12,11 @@
 ;;; Code:
 
 (add-to-load-path (string-append (dirname (dirname (current-filename))) "/module"))
+(add-to-load-path (dirname (current-filename)))
 
 (use-modules (hnh util)
-             (srfi srfi-1))
-
-
-(define (get-forms port)
-  (let loop ((done '()))
-    (let ((form (read port)))
-      (if (eof-object? form)
-          done
-          (loop (cons form done))))))
-
-(define (flatten-tree tree)
-  (cond ((null? tree) '())
-        ((pair? tree)
-         (append (flatten-tree (car tree))
-                 (flatten-tree (cdr tree))))
-        (else (list tree))))
-
-
-
-(define (uniq lst)
-  (cond ((null? lst) lst)
-        ((null? (cdr lst)) lst)
-        ((and (pair? lst)
-              (eqv? (car lst) (cadr lst)))
-         (uniq (cons (car lst) (cddr lst))))
-        (else (cons (car lst)
-                    (uniq (cdr lst))))))
-
-(define (unique-symbols tree)
-  (uniq
-   (sort* (filter symbol? (flatten-tree tree))
-          string<? symbol->string)))
-
-(define (find-module-declaration forms)
-  (cadr 
-  (find (lambda (form)
-          (cond ((null? form) #f)
-                ((not (pair? form)) #f)
-                (else (eq? 'define-module (car form)))))
-        forms)))
+             (srfi srfi-1)
+             (module-introspection))
 
 
 ;;; Module use high scores
@@ -62,6 +25,7 @@
 (define (main args)
   (define filename (cadr args))
   (define forms (reverse (call-with-input-file filename get-forms)))
+  ;; All symbols in source file
   (define symbs (unique-symbols forms))
   ;; (format #t "~y" (find-module-declaration forms))
   ;; (format #t "~a~%" symbs)
@@ -69,20 +33,22 @@
   (format #t "=== ~a ===~%" filename)
   (for-each (lambda (mod)
 
+              ;; all symbols imported from module
+              (define all-symbols (module-map (lambda (key value) key) mod))
+
+              ;; Thes subset of all imported symbols from module which are used
               (define used-symbols
-                (map (lambda (symb)
-                       (if (memv symb symbs)
-                         #f symb))
-                     (module-map (lambda (key value) key) mod)))
+                (filter (lambda (symb) (memv symb symbs))
+                        all-symbols))
 
-              (define used-count (count not used-symbols))
+              (define used-count (length used-symbols))
               (define total-count (length (module-map list mod)))
 
               (format #t "~a/~a  ~a~%    used ~s~%  unused ~s~%"
                       used-count total-count (module-name mod)
-                      (lset-difference eq?  (module-map (lambda (key value) key) mod) (filter identity used-symbols))
-                      (filter identity used-symbols)
-                      ))
+                      used-symbols
+                      (lset-difference eq? all-symbols used-symbols)))
+
             (remove (lambda (mod)
                       (member (module-name mod)
                               '((guile)
diff --git a/scripts/module-introspection.scm b/scripts/module-introspection.scm
new file mode 100644
index 00000000..008deb56
--- /dev/null
+++ b/scripts/module-introspection.scm
@@ -0,0 +1,49 @@
+(define-module (module-introspection)
+  :use-module (srfi srfi-1)
+  :use-module (hnh util)
+  :export (get-forms
+           uniq
+           unique-symbols
+           find-module-declaration
+           ))
+
+
+(define (get-forms port)
+  (let loop ((done '()))
+    (let ((form (read port)))
+      (if (eof-object? form)
+          done
+          (loop (cons form done))))))
+
+
+(define (uniq lst)
+  (cond ((null? lst) lst)
+        ((null? (cdr lst)) lst)
+        ((and (pair? lst)
+              (eqv? (car lst) (cadr lst)))
+         (uniq (cons (car lst) (cddr lst))))
+        (else (cons (car lst)
+                    (uniq (cdr lst))))))
+
+
+(define (unique-symbols tree)
+  (uniq
+   (sort* (filter symbol? (flatten-tree tree))
+          string<? symbol->string)))
+
+
+(define (flatten-tree tree)
+  (cond ((null? tree) '())
+        ((pair? tree)
+         (append (flatten-tree (car tree))
+                 (flatten-tree (cdr tree))))
+        (else (list tree))))
+
+
+(define (find-module-declaration forms)
+  (and=> (find (lambda (form)
+                 (cond ((null? form) #f)
+                       ((not (pair? form)) #f)
+                       (else (eq? 'define-module (car form)))))
+               forms)
+         cadr))
-- 
cgit v1.2.3