blob: a5b62311d281502feac875283d98335cfca95c69 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
(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))
string<? symbol->string)))
(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))
|
