procedure-analysis takes an optional module argument

This commit is contained in:
Alex Shinn 2014-07-28 22:52:56 +09:00
parent 9ce81e9223
commit 7469dd82da

View file

@ -22,11 +22,13 @@
(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) (define (module-name mod)
(if (pair? mod)
(car mod)
(let lp ((ls *modules*)) (let lp ((ls *modules*))
(and (pair? ls) (and (pair? ls)
(if (eq? mod (cdar ls)) (if (eq? mod (cdar ls))
(caar ls) (caar ls)
(lp (cdr ls)))))) (lp (cdr ls)))))))
(define (module-dir mod) (define (module-dir mod)
(let ((name (module-name mod))) (let ((name (module-name mod)))
@ -140,10 +142,10 @@
(car ls) (car ls)
(lp2 (cdr e-ls)))))))))) (lp2 (cdr e-ls))))))))))
(define (procedure-analysis x) (define (procedure-analysis x . o)
(let ((mod (containing-module x))) (let ((mod (or (and (pair? o) (car o)) (containing-module x))))
(and mod (and mod
(let lp ((ls (module-ast (analyze-module (car mod))))) (let lp ((ls (module-ast (analyze-module (module-name mod)))))
(and (pair? ls) (and (pair? ls)
(if (and (set? (car ls)) (if (and (set? (car ls))
(eq? (procedure-name x) (ref-name (set-var (car ls))))) (eq? (procedure-name x) (ref-name (set-var (car ls)))))