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

fixed a bug in expanding macros in definition context where the 

scope would get messed up when the macro call appears inside
let/letrec-syntax.  Basically, in the following example,

(let-syntax ([id-macro (syntax-rules () [(_ x) x])])
  (let () 
    (define (foo) (display "not ok\n")) 
    (let-syntax ([foo (syntax-rules () [(_) (display "ok\n")])])
      (id-macro (foo)))))

the call to (id-macro) would make (foo) refer to the foo in the
internal-definition context (the not ok one) instead of the
let-syntax one.

On the plus side, macro expansion is now half a second faster!
This commit is contained in:
Abdulaziz Ghuloum 2009-07-06 12:14:08 +03:00
parent cda06eba58
commit acbd00c356
4 changed files with 28 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.4.prebuilt
View File

Binary file not shown.

BIN
scheme/ikarus.boot.8.prebuilt
View File

Binary file not shown.

2
scheme/last-revision
View File

@ -1 +1 @@
1824
1825

42
scheme/psyntax.expander.ss
View File

@ -3077,6 +3077,24 @@
(cons (cons lab (cons '$module iface)) mr)
mod** kwd*)))))))))
(define (copy-rib-contents! from-rib to-rib sd?)
(for-each
(lambda (sym mark* label)
(let ([id (make-stx sym mark* '() '())])
(extend-rib! to-rib id label sd?)))
(rib-sym* from-rib) (rib-mark** from-rib) (rib-label* from-rib)))
(define chi-body*-macro
(lambda (e* r mr lex* rhs* mod** kwd* exp* rib mix? sd? e)
(let ([rib2 (make-empty-rib)])
(let-values ([(e1* r mr lex* rhs* mod** kwd* exp*)
(chi-body* (list (add-subst rib2 e))
r mr lex* rhs* mod** kwd* exp* rib2 mix? sd?)])
(copy-rib-contents! rib2 rib sd?)
(if (null? e1*)
(chi-body* e* r mr lex* rhs* mod** kwd* exp* rib mix? sd?)
(values (append e1* e*) r mr lex* rhs* mod** kwd* exp*))))))
(define chi-body*
(lambda (e* r mr lex* rhs* mod** kwd* exp* rib mix? sd?)
(cond
@ -3144,23 +3162,17 @@
r mr lex* rhs* mod** kwd* exp* rib
mix? sd?)))))
((global-macro global-macro!)
(chi-body*
(cons (add-subst rib (chi-global-macro value e r))
(cdr e*))
r mr lex* rhs* mod** kwd* exp* rib
mix? sd?))
(chi-body*-macro (cdr e*)
r mr lex* rhs* mod** kwd* exp* rib mix? sd?
(chi-global-macro value e r)))
((local-macro local-macro!)
(chi-body*
(cons (add-subst rib (chi-local-macro value e r))
(cdr e*))
r mr lex* rhs* mod** kwd* exp* rib
mix? sd?))
(chi-body*-macro (cdr e*)
r mr lex* rhs* mod** kwd* exp* rib mix? sd?
(chi-local-macro value e r)))
((macro macro!)
(chi-body*
(cons (add-subst rib (chi-macro value e r))
(cdr e*))
r mr lex* rhs* mod** kwd* exp* rib mix?
sd?))
(chi-body*-macro (cdr e*)
r mr lex* rhs* mod** kwd* exp* rib mix? sd?
(chi-macro value e r)))
((module)
(let-values (((lex* rhs* m-exp-id* m-exp-lab* r mr mod** kwd*)
(chi-internal-module e r mr lex* rhs* mod** kwd*)))