fix make-syntax-delta-introducer with a #f argument

Closes PR 15202
This commit is contained in:
Matthew Flatt 2015-12-15 17:06:48 -07:00
parent 11f76cbebf
commit ca237910b3
3 changed files with 14 additions and 3 deletions

View File

@ -947,6 +947,8 @@ and different result procedures use distinct scopes.
Produces a procedure that behaves like the result of
@racket[make-syntax-introducer], but using the @tech{scopes} of
@racket[ext-stx] that are not shared with @racket[base-stx].
A @racket[#f] value for @racket[base-stx] is equivalent to a syntax
object with no @tech{scopes}.
This procedure is potentially useful when some @racket[_m-id] has a
transformer binding that records some @racket[_orig-id], and a use of

View File

@ -148,6 +148,17 @@
(test #f syntax-original? ((make-syntax-introducer) #'here))
(test #t syntax-original? ((make-syntax-introducer #t) #'here))
(let* ([a (datum->syntax #f 'a)]
[a1 ((make-syntax-introducer) a)]
[a2 ((make-syntax-introducer) a)])
(test #f bound-identifier=? a1 a2)
(test #t bound-identifier=? a1 ((make-syntax-delta-introducer a1 a2) a))
(test #t bound-identifier=? a2 ((make-syntax-delta-introducer a2 a1) a))
(test #t bound-identifier=? a2 ((make-syntax-delta-introducer a2 #f) a))
(test #t bound-identifier=?
((make-syntax-delta-introducer a1 a2) a2)
((make-syntax-delta-introducer a2 a1) a1)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test basic expansion and property propagation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -8006,12 +8006,10 @@ Scheme_Object *scheme_syntax_make_transfer_intro(int argc, Scheme_Object **argv)
} else
m2 = NULL;
if (!m2) {
if (!m2 && !SCHEME_FALSEP(src)) {
src = scheme_stx_lookup_w_nominal(argv[1], phase, 1,
NULL, NULL, &m2,
NULL, NULL, NULL, NULL, NULL);
if (SCHEME_FALSEP(src))
m2 = NULL;
}
if (m2) {