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

psyntax can trace expand-time changes to the current module

Browse source 
* module/ice-9/psyntax.scm (expand-top-sequence): Support expand-time
  changes to the current module.
* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo 2016-06-27 22:54:04 +02:00
parent e264117e1b
commit a62d46ffff
2 changed files with 124 additions and 106 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -583,8 +583,17 @@
(lp (cdr body) (append (parse1 (car body) r w s m esew mod) exps)))))) (lp (cdr body) (append (parse1 (car body) r w s m esew mod) exps))))))
(parse1 (parse1
(lambda (x r w s m esew mod) (lambda (x r w s m esew mod)
(letrec*
((current-module-for-expansion
(lambda (mod)
(let ((key (car mod)))
(if (memv key '(hygiene))
(cons 'hygiene (module-name (current-module)))
mod)))))
(call-with-values (call-with-values
(lambda () (syntax-type x r w (source-annotation x) ribcage mod #f)) (lambda ()
(let ((mod (current-module-for-expansion mod)))
(syntax-type x r w (source-annotation x) ribcage mod #f)))
(lambda (type value form e w s mod) (lambda (type value form e w s mod)
(let ((key type)) (let ((key type))
(cond ((memv key '(define-form)) (cond ((memv key '(define-form))
@ -690,7 +699,7 @@
(let ((x (expand-expr type value form e r w s mod))) (let ((x (expand-expr type value form e r w s mod)))
(top-level-eval-hook x mod) (top-level-eval-hook x mod)
(lambda () x)) (lambda () x))
(lambda () (expand-expr type value form e r w s mod)))))))))))) (lambda () (expand-expr type value form e r w s mod)))))))))))))
(let ((exps (map (lambda (x) (x)) (reverse (parse body r w s m esew mod))))) (let ((exps (map (lambda (x) (x)) (reverse (parse body r w s m esew mod)))))
(if (null? exps) (build-void s) (build-sequence s exps))))))) (if (null? exps) (build-void s) (build-sequence s exps)))))))
(expand-install-global (expand-install-global

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

@ -1087,9 +1087,18 @@
(append (parse1 (car body) r w s m esew mod) (append (parse1 (car body) r w s m esew mod)
exps))))) exps)))))
(define (parse1 x r w s m esew mod) (define (parse1 x r w s m esew mod)
(define (current-module-for-expansion mod)
(case (car mod)
;; If the module was just put in place for hygiene, in a
;; top-level `begin' always recapture the current
;; module. If a user wants to override, then we need to
;; use @@ or similar.
((hygiene) (cons 'hygiene (module-name (current-module))))
(else mod)))
(call-with-values (call-with-values
(lambda () (lambda ()
(syntax-type x r w (source-annotation x) ribcage mod #f)) (let ((mod (current-module-for-expansion mod)))
(syntax-type x r w (source-annotation x) ribcage mod #f)))
(lambda (type value form e w s mod) (lambda (type value form e w s mod)
(case type (case type
((define-form) ((define-form)