mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 15:00:21 +02:00
Code Activity

psyntax expander tracks changes to current module in top-level begin

Browse source 
* module/ice-9/psyntax-pp.scm: Regenerated.
* module/ice-9/psyntax.scm (chi-top-sequence): Track changes to the
  current module. Allows e.g. top-level `define-module' within a begin
  to work.

* test-suite/tests/syncase.test ("changes to expansion environment"):
  Enable test.
This commit is contained in:
Andy Wingo 2010-03-03 23:09:08 +01:00
parent 05c51bcff5
commit 54096be752
3 changed files with 6419 additions and 6386 deletions
Download patch file Download diff file Expand all files Collapse all files

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

File diff suppressed because it is too large Load diff

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

@ -1023,12 +1023,34 @@
(define chi-top-sequence (define chi-top-sequence
(lambda (body r w s m esew mod) (lambda (body r w s m esew mod)
;; Expanding a sequence of toplevel expressions can affect the
;; expansion-time environment in several ways -- by adding or changing
;; top-level syntactic bindings, by defining new modules, and by changing
;; the current module -- among other ways.
;;
;; Of all of these, changes to the current module need to be treated
;; specially, as modules have specific support in the expander, for
;; purposes of maintaining hygiene. (In contrast, changes to parts of the
;; global state that are not specifically treated by the expander are
;; visible by default, without special support.)
;;
;; So, the deal. In the expression, (begin (define-module (foo)) (bar)),
;; we need to expand (bar) within the (foo) module. More generally, in a
;; top-level sequence, if the module after expanding a form is not the
;; same as the module before expanding the form, we expand subsequent
;; forms in the new module.
(build-sequence s (build-sequence s
(let dobody ((body body) (r r) (w w) (m m) (esew esew) (mod mod)) (let dobody ((body body) (r r) (w w) (m m) (esew esew) (mod mod)
(module (current-module)) (out '()))
(if (null? body) (if (null? body)
'() (reverse out)
(let ((first (chi-top (car body) r w m esew mod))) (let* ((first (chi-top (car body) r w m esew mod))
(cons first (dobody (cdr body) r w m esew mod)))))))) (new-module (current-module)))
(dobody (cdr body) r w m esew
(if (eq? module new-module)
mod
(cons 'hygiene (module-name new-module)))
new-module (cons first out))))))))
(define chi-install-global (define chi-install-global
(lambda (name e) (lambda (name e)

6
test-suite/tests/syncase.test
View file

@ -1,6 +1,6 @@
;;;; syncase.test --- test suite for (ice-9 syncase) -*- scheme -*- ;;;; syncase.test --- test suite for (ice-9 syncase) -*- scheme -*-
;;;; ;;;;
;;;; Copyright (C) 2001, 2006, 2009 Free Software Foundation, Inc. ;;;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -109,7 +109,6 @@
(with-test-prefix "changes to expansion environment" (with-test-prefix "changes to expansion environment"
(pass-if "expander detects changes to current-module" (pass-if "expander detects changes to current-module"
(or (false-if-exception
(compile '(begin (compile '(begin
(define-module (new-module)) (define-module (new-module))
(define-syntax new-module-macro (define-syntax new-module-macro
@ -117,5 +116,4 @@
(syntax-case stx () (syntax-case stx ()
((_ arg) (syntax arg))))) ((_ arg) (syntax arg)))))
(new-module-macro #t)) (new-module-macro #t))
#:env (current-module))) #:env (current-module))))
(throw 'unresolved))))