conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* expander now uses imported-label->binding to resolve imported 

bindings.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-02 18:16:25 -04:00
parent 7aa29c5a00
commit 4c4af70ffc
2 changed files with 5 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

17
src/libsyntax.ss
View File

@ -293,6 +293,7 @@
(cond (cond
[(not x) (cons 'unbound #f)] [(not x) (cons 'unbound #f)]
[(assq x r) => cdr] [(assq x r) => cdr]
[(imported-label->binding x)]
[else (cons 'displaced-lexical #f)]))) [else (cons 'displaced-lexical #f)])))
(define make-binding cons) (define make-binding cons)
(define binding-type car) (define binding-type car)
@ -562,12 +563,6 @@
(make-rib (list name) (list top-mark*) (list label)) (make-rib (list name) (list top-mark*) (list label))
(stx sym top-mark* '()))))] (stx sym top-mark* '()))))]
[else (stx sym top-mark* '())])))) [else (stx sym top-mark* '())]))))
(define make-scheme-env
(lambda ()
(let-values ([(subst env)
(library-subst/env
(find-library-by-name '(scheme)))])
env)))
;;; macros ;;; macros
(define add-lexicals (define add-lexicals
(lambda (lab* lex* r) (lambda (lab* lex* r)
@ -1975,13 +1970,12 @@
(lambda (e) (lambda (e)
(let-values ([(name exp* imp* b*) (parse-library e)]) (let-values ([(name exp* imp* b*) (parse-library e)])
(let-values ([(subst lib*) (get-import-subst/libs imp*)]) (let-values ([(subst lib*) (get-import-subst/libs imp*)])
(let ([rib (make-top-rib subst)] (let ([rib (make-top-rib subst)])
[r (make-scheme-env)])
(let ([b* (map (lambda (x) (stx x top-mark* (list rib))) b*)] (let ([b* (map (lambda (x) (stx x top-mark* (list rib))) b*)]
[kwd* (map (lambda (sym mark*) (stx sym mark* (list rib))) [kwd* (map (lambda (sym mark*) (stx sym mark* (list rib)))
(rib-sym* rib) (rib-mark** rib))]) (rib-sym* rib) (rib-mark** rib))])
(let-values ([(init* r mr lex* rhs*) (let-values ([(init* r mr lex* rhs*)
(chi-library-internal b* r rib kwd*)]) (chi-library-internal b* '() rib kwd*)])
(let ([rhs* (chi-rhs* rhs* r mr)]) (let ([rhs* (chi-rhs* rhs* r mr)])
(let ([body (if (null? init*) (let ([body (if (null? init*)
(build-void) (build-void)
@ -1992,13 +1986,12 @@
(lambda (e) (lambda (e)
(let-values ([(name exp* imp* b*) (parse-library e)]) (let-values ([(name exp* imp* b*) (parse-library e)])
(let-values ([(subst lib*) (get-import-subst/libs imp*)]) (let-values ([(subst lib*) (get-import-subst/libs imp*)])
(let ([rib (make-top-rib subst)] (let ([rib (make-top-rib subst)])
[r (make-scheme-env)])
(let ([b* (map (lambda (x) (stx x top-mark* (list rib))) b*)] (let ([b* (map (lambda (x) (stx x top-mark* (list rib))) b*)]
[kwd* (map (lambda (sym mark*) (stx sym mark* (list rib))) [kwd* (map (lambda (sym mark*) (stx sym mark* (list rib)))
(rib-sym* rib) (rib-mark** rib))]) (rib-sym* rib) (rib-mark** rib))])
(let-values ([(init* r mr lex* rhs*) (let-values ([(init* r mr lex* rhs*)
(chi-library-internal b* r rib kwd*)]) (chi-library-internal b* '() rib kwd*)])
(let ([rhs* (chi-rhs* rhs* r mr)]) (let ([rhs* (chi-rhs* rhs* r mr)])
(let ([body (if (and (null? init*) (null? lex*)) (let ([body (if (and (null? init*) (null? lex*))
(build-void) (build-void)