Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 22:59:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding module-includes

Browse source
This commit is contained in:
Alex Shinn 2011-04-08 01:57:47 +09:00
parent b3cc58bb94
commit b1b207504c
2 changed files with 37 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lib/chibi/modules.module
View file

@ -1,7 +1,8 @@
(module (chibi modules) (module (chibi modules)
(export analyze-module module-ast module-ast-set! (export module-name module-dir module-includes
module-ref module-contains? containing-module module-ast module-ast-set! module-ref module-contains?
analyze-module containing-module
procedure-analysis) procedure-analysis)
(import-immutable (scheme) (config)) (import-immutable (scheme) (config))
(import (chibi ast)) (import (chibi ast))

42
lib/chibi/modules.scm
View file

@ -1,3 +1,6 @@
;; modules.scm -- module introspection utilities
;; Copyright (c) 2011 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
(define (file->sexp-list file) (define (file->sexp-list file)
(call-with-input-file file (call-with-input-file file
@ -8,14 +11,42 @@
(reverse res) (reverse res)
(lp (cons x res)))))))) (lp (cons x res))))))))
(define (module? x) (vector? x)) (define (module? x)
(and (vector? x) (>= (vector-length x) 4) (list? (vector-ref x 0))))
(define (module-ast mod) (vector-ref mod 3)) (define (module-ast mod) (vector-ref mod 3))
(define (module-ast-set! mod x) (vector-set! mod 3 x)) (define (module-ast-set! mod x) (vector-set! mod 3 x))
(define (module-name mod)
(let lp ((ls *modules*))
(and (pair? ls)
(if (eq? mod (cdar ls))
(caar ls)
(lp (cdr ls))))))
(define (module-dir mod)
(let ((name (module-name mod)))
(if (member name '((scheme) (config)))
""
(module-name-prefix name))))
(define (module-includes mod)
(let* ((mod (if (module? mod) mod (find-module mod)))
(dir (module-dir mod)))
(define (module-file f)
(find-module-file (string-append dir f)))
(let lp ((ls (module-meta-data mod)) (res '()))
(cond
((not (pair? ls))
(reverse res))
((and (pair? (car ls)) (eq? 'include (caar ls)))
(lp (cdr ls) (append (map module-file (reverse (cdar ls))) res)))
(else
(lp (cdr ls) res))))))
(define (analyze-module-source name mod recursive?) (define (analyze-module-source name mod recursive?)
(let ((env (module-env mod)) (let ((env (module-env mod))
(dir (if (equal? name '(scheme)) "" (module-name-prefix name)))) (dir (module-dir mod)))
(define (include-source file) (define (include-source file)
(cond ((find-module-file (string-append dir file)) (cond ((find-module-file (string-append dir file))
=> (lambda (x) (cons 'body (file->sexp-list x)))) => (lambda (x) (cons 'body (file->sexp-list x))))
@ -71,11 +102,7 @@
(let lp ((ls (module-ast mod))) (let lp ((ls (module-ast mod)))
(and (pair? ls) (and (pair? ls)
(or (and (set? (car ls)) (or (and (set? (car ls))
(eq? var-name (ref-name (set-var (car ls)))) (eq? var-name (ref-name (set-var (car ls)))))
(begin
;; (write `(found ,var-name in ,name ,(ast->sexp (car ls))) (current-error-port))
;; (newline (current-error-port))
#t))
(lp (cdr ls)))))) (lp (cdr ls))))))
(define (containing-module x) (define (containing-module x)
@ -100,4 +127,3 @@
(eq? (procedure-name x) (ref-name (set-var (car ls))))) (eq? (procedure-name x) (ref-name (set-var (car ls)))))
(set-value (car ls)) (set-value (car ls))
(lp (cdr ls)))))))) (lp (cdr ls))))))))