From 49cd07dad15692e8b4b6a320bc83ee84aac08a92 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Tue, 20 Jul 2010 08:53:43 +0900
Subject: [PATCH] adding modules introspection lib currently just
 analyze-module to return all top-level forms of a module analyzed in the
 internal AST form.

---
 lib/chibi/modules.module |  5 ++++
 lib/chibi/modules.scm    | 64 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 69 insertions(+)
 create mode 100644 lib/chibi/modules.module
 create mode 100644 lib/chibi/modules.scm

diff --git a/lib/chibi/modules.module b/lib/chibi/modules.module
new file mode 100644
index 00000000..dd00c3b1
--- /dev/null
+++ b/lib/chibi/modules.module
@@ -0,0 +1,5 @@
+
+(define-module (chibi modules)
+  (export analyze-module)
+  (import-immutable (scheme) (config) (chibi ast))
+  (include "modules.scm"))
diff --git a/lib/chibi/modules.scm b/lib/chibi/modules.scm
new file mode 100644
index 00000000..f17f0cd1
--- /dev/null
+++ b/lib/chibi/modules.scm
@@ -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)))))))))))))