fix problem in `free-identifier=?'

Renamings created by a rename-transformer binding were not treated
correctly by `free-identifier=?'.

Closes PR 12623
This commit is contained in:
Matthew Flatt 2013-05-20 14:35:41 -06:00
parent f225eedc24
commit a48154a665
2 changed files with 69 additions and 3 deletions

View File

@ -853,6 +853,68 @@
(eval '(def t))
(eval '(t)))
;; ----------------------------------------
;; Check that a `free-identifier=?' mapping via a rename transformer
;; doesn't mess up a `free-identifier=?' test where the relevant
;; identifier is shadowed with a lexical binding; this test was
;; provided by Carl Eastlund.
(module lang-for-identifier=?-test racket/base
(#%module-begin
(provide
#%module-begin
(all-from-out racket/base)
(for-syntax
(all-from-out racket/base)
(all-from-out syntax/parse)))
(require
(for-syntax
racket/base
syntax/parse))
(define-syntax (#%module-begin stx)
(syntax-parse stx
[(_ before ...)
(syntax-parse (local-expand
#'(#%plain-module-begin before ...)
'module-begin
'())
#:literal-sets {kernel-literals}
[(#%plain-module-begin
_
_
(#%plain-lambda {one:id}
(letrec-syntaxes+values _ _ two:id)))
(let ()
(when (bound-identifier=? #'one #'two)
(unless (free-identifier=? #'one #'two)
(error 'bug
"{bound,free}-identifier=? inconsistency")))
#'(#%plain-module-begin))])]))))
(module consistency-of-identifier=?-test 'lang-for-identifier=?-test
(#%module-begin
(define-syntaxes {lam}
(lambda (stx)
(syntax-parse stx
[(_ unmarked . body)
(define/syntax-parse marked
(syntax-local-introduce (attribute unmarked)))
#'(#%plain-lambda {marked}
(define-syntaxes {unmarked}
(make-rename-transformer #'marked))
. body)])))
(define-syntaxes {x}
(make-rename-transformer #'dummy))
(lam x x)))
;; ----------------------------------------
(report-errs)

View File

@ -4437,8 +4437,9 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
Scheme_Object *bdg = NULL;
result = ((Scheme_Stx *)a)->u.modinfo_cache;
if (result && SAME_OBJ(phase, scheme_make_integer(0)))
if (result && SAME_OBJ(phase, scheme_make_integer(0))) {
return result;
}
WRAP_POS_INIT(wraps, ((Scheme_Stx *)a)->wraps);
@ -4458,7 +4459,7 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
result = SCHEME_STX_VAL(a);
#if 0
printf("%p %p %s (%d) %d %p\n",
printf("%p %p %s (%d) %d %p\n",
a, orig_phase, SCHEME_SYMBOLP(result) ? SCHEME_SYM_VAL(result) : "!?",
can_cache, sealed, free_id_recur);
#endif
@ -4563,7 +4564,10 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
if (SCHEME_BOXP(rename)) {
/* only happens with free_id_renames */
rename = SCHEME_BOX_VAL(rename);
result = SCHEME_CAR(rename);
if (no_lexical || SCHEME_TRUEP(SCHEME_CDR(rename)))
result = SCHEME_CAR(rename);
else
rename = NULL;
} else if (SCHEME_PAIRP(rename)) {
if (nom_mod_p(rename)) {
result = glob_id;