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

Fixes bug 165133: Bodies of internal definitions should be expanded 

before right-hand-side expressions
This commit is contained in:
Abdulaziz Ghuloum 2007-11-30 06:31:07 -05:00
parent 51c8d1c0ed
commit 2d55282789
2 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/last-revision
View File

@ -1 +1 @@
1148 1149

14
scheme/psyntax.expander.ss
View File

@ -2550,8 +2550,9 @@
r mr '() '() '() '() rib #f))) r mr '() '() '() '() rib #f)))
(when (null? e*) (when (null? e*)
(stx-error e* "no expression in body")) (stx-error e* "no expression in body"))
(let ((rhs* (chi-rhs* rhs* r mr)) (let* ((init*
(init* (chi-expr* (append (apply append (reverse mod**)) e*) r mr))) (chi-expr* (append (apply append (reverse mod**)) e*) r mr))
(rhs* (chi-rhs* rhs* r mr)))
(build-letrec* no-source (build-letrec* no-source
(reverse lex*) (reverse rhs*) (reverse lex*) (reverse rhs*)
(build-sequence no-source init*))))))) (build-sequence no-source init*)))))))
@ -3114,6 +3115,7 @@
(values (append (apply append (reverse mod**)) e*) (values (append (apply append (reverse mod**)) e*)
r mr (reverse lex*) (reverse rhs*))))) r mr (reverse lex*) (reverse rhs*)))))
(define library-body-expander (define library-body-expander
(lambda (exp* imp* b* top?) (lambda (exp* imp* b* top?)
(define itc (make-collector)) (define itc (make-collector))
@ -3129,11 +3131,11 @@
(let-values (((init* r mr lex* rhs*) (let-values (((init* r mr lex* rhs*)
(chi-library-internal b* rib top?))) (chi-library-internal b* rib top?)))
(seal-rib! rib) (seal-rib! rib)
(let ((rhs* (chi-rhs* rhs* r mr)) (let* ((init* (chi-expr* init* r mr))
(loc* (map gen-global lex*)) (rhs* (chi-rhs* rhs* r mr)))
(init* (chi-expr* init* r mr)))
(unseal-rib! rib) (unseal-rib! rib)
(let ((export-subst (make-export-subst exp-int* exp-ext* rib))) (let ((loc* (map gen-global lex*))
(export-subst (make-export-subst exp-int* exp-ext* rib)))
(define errstr (define errstr
"attempt to export mutated variable") "attempt to export mutated variable")
(let-values (((export-env global* macro*) (let-values (((export-env global* macro*)