diff options
Diffstat (limited to '')
-rw-r--r-- | scripts/module-introspection.scm | 49 |
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)) |