aboutsummaryrefslogtreecommitdiff
path: root/scripts/module-introspection.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-02-01 00:49:31 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2022-02-01 00:49:31 +0100
commit656d75af3de53f1f30d34f7a8eb36c6e45fb86d8 (patch)
treec8db02f6ae1dd08c5d4b2f1c164fdd032cdd8f75 /scripts/module-introspection.scm
parentRename scripts/{all-symbols => module-import}.scm (diff)
downloadcalp-656d75af3de53f1f30d34f7a8eb36c6e45fb86d8.tar.gz
calp-656d75af3de53f1f30d34f7a8eb36c6e45fb86d8.tar.xz
Broke module-import script into library component.
Diffstat (limited to '')
-rw-r--r--scripts/module-introspection.scm49
1 files changed, 49 insertions, 0 deletions
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))