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-introspection.scm | 49 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 scripts/module-introspection.scm

(limited to 'scripts/module-introspection.scm')

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