macro expander: fix identifier-binding on fully expanded module

Fix the case of an identifier that is used as a binding in a module
but originated from a different module.
This commit is contained in:
Matthew Flatt 2014-07-25 07:20:28 +01:00
parent bd60509bf6
commit ccda0e4abb
2 changed files with 36 additions and 1 deletions

View File

@ -920,6 +920,33 @@
(test 'yes dynamic-require ''uses-id-not-id* 'answer)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check binding in fully expanded module:
(let ()
(define m
'(module m racket/kernel
(module foo racket
(provide def-wrap)
(define-syntax-rule (def-wrap)
(begin (define y 1) y)))
(module bar racket/kernel
(#%require (submod ".." foo))
(def-wrap))))
(parameterize ([current-namespace (make-base-namespace)])
(define e (expand m))
;; (pretty-print (syntax->datum e))
(syntax-case e (module)
[(module m _
(#%mb1
_
(module bar _
(#%mb2
(#%require (submod ".." foo))
(define-values (y) '1)
_))))
(test #t list? (identifier-binding #'y))])))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -3097,6 +3097,7 @@ static Scheme_Object *get_old_module_env(Scheme_Object *stx)
WRAP_POS awl;
Scheme_Object *a, *last_id = NULL, *cancel_rename_id = scheme_false;
Scheme_Object *result_id = scheme_false, *last_pr = NULL, *pr;
int saw_rename = 0;
WRAP_POS_INIT(awl, ((Scheme_Stx *)stx)->wraps);
@ -3155,13 +3156,20 @@ static Scheme_Object *get_old_module_env(Scheme_Object *stx)
}
last_id = set_identity;
}
/* Only cancel via phase shift after we've seen a rename.
Canceling makes submodule contexts work, while not canceling
until after a rename makes inspection of a fully-expanded
module work in the case that a binding's indentifier cam from
another module. */
saw_rename = 1;
} else if (SCHEME_BOXP(a)) {
/* Phase shift: */
Scheme_Object *vec;
vec = SCHEME_BOX_VAL(a);
a = SCHEME_VEC_ELS(vec)[5];
if (!SCHEME_FALSEP(a))
if (saw_rename && !SCHEME_FALSEP(a))
cancel_rename_id = a;
}