mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

Do not defer expansion of internal define-syntax forms.

Browse source 
* module/ice-9/psyntax.scm (expand-body): As required by R6RS, evaluate
  the right-hand-sides of internal 'define-syntax' forms and add their
  transformers to the compile-time environment immediately, so that the
  newly-defined keywords may be used in definition context within the
  same lexical contour.  Fixes #13509.
This commit is contained in:
Mark H Weaver 2013-01-23 17:49:38 -05:00
parent 32e3c505c3
commit ceb7f9cc12
2 changed files with 25 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

29
module/ice-9/psyntax-pp.scm
View file

@ -991,15 +991,17 @@
(cons (cons er (wrap e w mod)) vals)
(cons (cons 'lexical var) bindings)))))
((memv key '(define-syntax-form define-syntax-parameter-form))
(let ((id (wrap value w mod)) (label (gen-label)))
(let ((id (wrap value w mod))
(label (gen-label))
(trans-r (macros-only-env er)))
(extend-ribcage! ribcage id label)
(parse (cdr body)
(cons id ids)
(cons label labels)
var-ids
vars
vals
(cons (cons 'macro (cons er (wrap e w mod))) bindings))))
(set-cdr!
r
(extend-env
(list label)
(list (cons 'macro (eval-local-transformer (expand e trans-r w mod) mod)))
(cdr r)))
(parse (cdr body) (cons id ids) labels var-ids vars vals bindings)))
((memv key '(begin-form))
(let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ . each-any))))
(if tmp
@ -1049,17 +1051,6 @@
#f
"invalid or duplicate identifier in definition"
outer-form))
(let loop ((bs bindings) (er-cache #f) (r-cache #f))
(if (not (null? bs))
(let ((b (car bs)))
(if (eq? (car b) 'macro)
(let* ((er (cadr b))
(r-cache (if (eq? er er-cache) r-cache (macros-only-env er))))
(set-cdr!
b
(eval-local-transformer (expand (cddr b) r-cache '(()) mod) mod))
(loop (cdr bs) er r-cache))
(loop (cdr bs) er-cache r-cache)))))
(set-cdr! r (extend-env labels bindings (cdr r)))
(build-letrec
#f

36
module/ice-9/psyntax.scm
View file

@ -1470,13 +1470,22 @@
(cons var vars) (cons (cons er (wrap e w mod)) vals)
(cons (make-binding 'lexical var) bindings)))))
((define-syntax-form define-syntax-parameter-form)
(let ((id (wrap value w mod)) (label (gen-label)))
(let ((id (wrap value w mod))
(label (gen-label))
(trans-r (macros-only-env er)))
(extend-ribcage! ribcage id label)
(parse (cdr body)
(cons id ids) (cons label labels)
var-ids vars vals
(cons (make-binding 'macro (cons er (wrap e w mod)))
bindings))))
;; As required by R6RS, evaluate the right-hand-sides of internal
;; syntax definition forms and add their transformers to the
;; compile-time environment immediately, so that the newly-defined
;; keywords may be used in definition context within the same
;; lexical contour.
(set-cdr! r (extend-env (list label)
(list (make-binding 'macro
(eval-local-transformer
(expand e trans-r w mod)
mod)))
(cdr r)))
(parse (cdr body) (cons id ids) labels var-ids vars vals bindings)))
((begin-form)
(syntax-case e ()
((_ e1 ...)
@ -1507,21 +1516,6 @@
(syntax-violation
#f "invalid or duplicate identifier in definition"
outer-form))
(let loop ((bs bindings) (er-cache #f) (r-cache #f))
(if (not (null? bs))
(let* ((b (car bs)))
(if (eq? (car b) 'macro)
(let* ((er (cadr b))
(r-cache
(if (eq? er er-cache)
r-cache
(macros-only-env er))))
(set-cdr! b
(eval-local-transformer
(expand (cddr b) r-cache empty-wrap mod)
mod))
(loop (cdr bs) er r-cache))
(loop (cdr bs) er-cache r-cache)))))
(set-cdr! r (extend-env labels bindings (cdr r)))
(build-letrec no-source #t
(reverse (map syntax->datum var-ids))