Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fix containing-module on opcodes (fixes issue #326).

Browse source
This commit is contained in:
Alex Shinn 2016-05-01 16:50:27 +09:00
parent b9244e39f6
commit 345da04e72
3 changed files with 51 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
lib/chibi/modules.scm
View file

@ -75,7 +75,13 @@
(cond ((find-module-file (string-append dir file)) (cond ((find-module-file (string-append dir file))
=> (lambda (x) (cons 'begin (file->sexp-list x)))) => (lambda (x) (cons 'begin (file->sexp-list x))))
(else (error "couldn't find include" file)))) (else (error "couldn't find include" file))))
(env-parent-set! env (module-env mod)) (cond
((equal? '(chibi) name)
(env-define! env '*features* *features*)
(env-define! env '*shared-object-extension* *shared-object-extension*)
(%import env (primitive-environment 7) #f #t))
(else
(resolve-module-imports env (module-meta-data mod))))
(let lp ((ls (module-meta-data mod)) (res '())) (let lp ((ls (module-meta-data mod)) (res '()))
(cond (cond
((not (pair? ls)) ((not (pair? ls))
@ -99,7 +105,9 @@
(let lp2 ((ls2 (cdar ls)) (res res)) (let lp2 ((ls2 (cdar ls)) (res res))
(cond (cond
((pair? ls2) ((pair? ls2)
(lp2 (cdr ls2) (cons (analyze (car ls2) env) res))) (let ((x (analyze (car ls2) env)))
(eval (car ls2) env)
(lp2 (cdr ls2) (cons x res))))
(else (else
(lp (cdr ls) res))))) (lp (cdr ls) res)))))
(else (else
@ -127,10 +135,12 @@
(define (module-defines? name mod var-name) (define (module-defines? name mod var-name)
(let lp ((ls (module-ast (analyze-module name)))) (let lp ((ls (module-ast (analyze-module name))))
(and (pair? ls) (cond
(or (and (set? (car ls)) ((null? ls) #f)
(eq? var-name (ref-name (set-var (car ls))))) ((and (set? (car ls))
(lp (cdr ls)))))) (eq? var-name (ref-name (set-var (car ls))))))
((seq? (car ls)) (lp (append (seq-ls (car ls)) (cdr ls))))
(else (lp (cdr ls))))))
(define (containing-module x) (define (containing-module x)
(let lp1 ((ls (reverse *modules*))) (let lp1 ((ls (reverse *modules*)))
@ -141,24 +151,30 @@
(lp1 (cdr ls)) (lp1 (cdr ls))
(let ((cell (env-cell env (car e-ls)))) (let ((cell (env-cell env (car e-ls))))
(if (and (eq? x (cdr cell)) (if (and (eq? x (cdr cell))
(module-defines? (caar ls) (cdar ls) (car cell))) (or (opcode? x)
(module-defines? (caar ls) (cdar ls) (car cell))))
(car ls) (car ls)
(lp2 (cdr e-ls)))))))))) (lp2 (cdr e-ls))))))))))
(define (procedure-analysis x . o) (define (procedure-analysis x . o)
(let ((name (if (procedure? x) (procedure-name x) x)) (cond
(mod (or (and (pair? o) (car o)) (containing-module x)))) ((opcode? x)
(and mod #f)
(let lp ((ls (module-ast (analyze-module (module-name mod))))) (else
(and (pair? ls) (let ((name (if (procedure? x) (procedure-name x) x))
(cond (mod (or (and (pair? o) (car o))
((and (set? (car ls)) (containing-module x))))
(eq? name (ref-name (set-var (car ls))))) (and mod
(set-value (car ls))) (let lp ((ls (module-ast (analyze-module (module-name mod)))))
((seq? (car ls)) (and (pair? ls)
(lp (append (seq-ls (car ls)) (cdr ls)))) (cond
(else ((and (set? (car ls))
(lp (cdr ls))))))))) (eq? name (ref-name (set-var (car ls)))))
(set-value (car ls)))
((seq? (car ls))
(lp (append (seq-ls (car ls)) (cdr ls))))
(else
(lp (cdr ls)))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; finding all available modules ;; finding all available modules

1
lib/chibi/modules.sld
View file

@ -11,5 +11,6 @@
(only (meta) (only (meta)
module-env module-meta-data module-exports module-env module-meta-data module-exports
make-module load-module find-module resolve-import make-module load-module find-module resolve-import
resolve-module-imports
module-name-prefix module-name->file *modules*)) module-name-prefix module-name->file *modules*))
(include "modules.scm")) (include "modules.scm"))

25
lib/meta-7.scm
View file

@ -137,6 +137,19 @@
(else (else
(error "couldn't find import" x)))) (error "couldn't find import" x))))
(define (resolve-module-imports env meta)
(for-each
(lambda (x)
(case (and (pair? x) (car x))
((import import-immutable)
(for-each
(lambda (m)
(let* ((mod2-name+imports (resolve-import m))
(mod2 (load-module (car mod2-name+imports))))
(%import env (module-env mod2) (cdr mod2-name+imports) #t)))
(cdr x)))))
meta))
(define (eval-module name mod . o) (define (eval-module name mod . o)
(let ((env (if (pair? o) (car o) (make-environment))) (let ((env (if (pair? o) (car o) (make-environment)))
(meta (module-meta-data mod)) (meta (module-meta-data mod))
@ -165,17 +178,7 @@
(module-meta-data-set! (module-meta-data-set!
mod mod
`((error "module attempted to reference itself while loading" ,name))) `((error "module attempted to reference itself while loading" ,name)))
(for-each (resolve-module-imports env meta)
(lambda (x)
(case (and (pair? x) (car x))
((import import-immutable)
(for-each
(lambda (m)
(let* ((mod2-name+imports (resolve-import m))
(mod2 (load-module (car mod2-name+imports))))
(%import env (module-env mod2) (cdr mod2-name+imports) #t)))
(cdr x)))))
meta)
(protect (protect
(exn (else (exn (else
(module-meta-data-set! mod meta) (module-meta-data-set! mod meta)