mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-09 05:57:36 +02:00
adding modules introspection lib
currently just analyze-module to return all top-level forms of a module analyzed in the internal AST form.
This commit is contained in:
parent
54005c4d66
commit
49cd07dad1
2 changed files with 69 additions and 0 deletions
5
lib/chibi/modules.module
Normal file
5
lib/chibi/modules.module
Normal file
|
@ -0,0 +1,5 @@
|
|||
|
||||
(define-module (chibi modules)
|
||||
(export analyze-module)
|
||||
(import-immutable (scheme) (config) (chibi ast))
|
||||
(include "modules.scm"))
|
64
lib/chibi/modules.scm
Normal file
64
lib/chibi/modules.scm
Normal file
|
@ -0,0 +1,64 @@
|
|||
|
||||
(define (file->sexp-list file)
|
||||
(call-with-input-file file
|
||||
(lambda (in)
|
||||
(let lp ((res '()))
|
||||
(let ((x (read in)))
|
||||
(if (eof-object? x)
|
||||
(reverse res)
|
||||
(lp (cons x res))))))))
|
||||
|
||||
;; load the module and return it with a list of all top-level forms in
|
||||
;; the module analyzed
|
||||
(define (analyze-module name . o)
|
||||
(let ((recursive? (and (pair? o) (car o)))
|
||||
(modules `(((scheme) . ,(find-module '(scheme))))))
|
||||
(let go ((name name))
|
||||
(let ((env (make-environment))
|
||||
(dir (module-name-prefix name)))
|
||||
(define (load-modules files extension)
|
||||
(for-each
|
||||
(lambda (f)
|
||||
(let ((f (string-append dir f extension)))
|
||||
(cond ((find-module-file f) => (lambda (x) (load x env)))
|
||||
(else (error "couldn't find include" f)))))
|
||||
files))
|
||||
(define (include-source file)
|
||||
(cond ((find-module-file (string-append dir file))
|
||||
=> (lambda (x) (cons 'body (file->sexp-list x))))
|
||||
(else (error "couldn't find include" file))))
|
||||
(cond
|
||||
((assoc name modules) => cdr)
|
||||
(else
|
||||
(let ((mod (find-module name)))
|
||||
(let lp ((ls (module-meta-data mod)) (res '()))
|
||||
(cond
|
||||
((not (pair? ls)) (reverse res))
|
||||
(else
|
||||
(case (and (pair? (car ls)) (caar ls))
|
||||
((import import-immutable)
|
||||
(for-each
|
||||
(lambda (m)
|
||||
(let* ((mod2-name+imports (resolve-import m))
|
||||
(mod2 (load-module (car mod2-name+imports))))
|
||||
(%env-copy! env (module-env mod2) (cdr mod2-name+imports)
|
||||
(eq? (caar ls) 'import-immutable))))
|
||||
(cdar ls))
|
||||
(lp (cdr ls) res))
|
||||
((include)
|
||||
(lp (append (map include-source (cdar ls)) (cdr ls)) res))
|
||||
((include-shared)
|
||||
(cond-expand
|
||||
(dynamic-loading
|
||||
(load-modules (cdar ls) *shared-object-extension*))
|
||||
(else #f)))
|
||||
((body)
|
||||
(let lp2 ((ls2 (cdar ls)) (res res))
|
||||
(cond
|
||||
((pair? ls2)
|
||||
(eval (car ls2) env)
|
||||
(lp2 (cdr ls2) (cons (analyze (car ls2)) res)))
|
||||
(else
|
||||
(lp (cdr ls) res)))))
|
||||
(else
|
||||
(lp (cdr ls) res)))))))))))))
|
Loading…
Add table
Reference in a new issue