suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Revert "Allow local-expand to opt-out of implicit extension of the stop list"

Browse Source 
This reverts commit 41fd4f3a5e.

The problems this change was intended to solve can be solved in other
ways, without loosening guarantees about expansion order. See the
discussion in #2154 for more details.

closes #2154
This commit is contained in:
Alexis King 2018-09-12 14:30:34 -05:00
parent 5be4109495
commit 6b56156d55
17 changed files with 4888 additions and 5341 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi) (define collection 'multi)
(define version "7.0.0.19") (define version "7.0.0.20")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

23
pkgs/racket-doc/scribblings/reference/reference.scrbl
View File

@ -46,7 +46,6 @@ language.
racket/private/stx racket/private/stx
racket/private/map racket/private/map
racket/private/list racket/private/list
racket/private/kw-syntax-local
racket/private/base)]{ racket/private/base)]{
Unless otherwise noted, the bindings defined in this manual are Unless otherwise noted, the bindings defined in this manual are
@ -120,16 +119,16 @@ The @racketmodname[racket] library combines
#:location "International Conference on Functional Programming (ICFP)" #:location "International Conference on Functional Programming (ICFP)"
#:date "2002") #:date "2002")
(bib-entry #:key "Friedman95" (bib-entry #:key "Friedman95"
#:title "Exception system proposal" #:title "Exception system proposal"
#:author "Daniel P. Friedman, C. T. Haynes, and R. Kent Dybvig" #:author "Daniel P. Friedman, C. T. Haynes, and R. Kent Dybvig"
#:location "web page" #:location "web page"
#:url "http://www.cs.indiana.edu/scheme-repository/doc.proposals.exceptions.html" #:url "http://www.cs.indiana.edu/scheme-repository/doc.proposals.exceptions.html"
#:date "1995") #:date "1995")
(bib-entry #:key "Gasbichler02" (bib-entry #:key "Gasbichler02"
#:title "Processes vs. User-Level Threads in Scsh" #:title "Processes vs. User-Level Threads in Scsh"
#:author "Martin Gasbichler and Michael Sperber" #:author "Martin Gasbichler and Michael Sperber"
#:date "2002" #:date "2002"
#:location "Workshop on Scheme and Functional Programming") #:location "Workshop on Scheme and Functional Programming")
@ -144,13 +143,13 @@ The @racketmodname[racket] library combines
#:title "Engines Build Process Abstractions" #:title "Engines Build Process Abstractions"
#:location "Symposium on LISP and Functional Programming" #:location "Symposium on LISP and Functional Programming"
#:date "1984") #:date "1984")
(bib-entry #:key "Hayes97" (bib-entry #:key "Hayes97"
#:author "Barry Hayes" #:author "Barry Hayes"
#:title "Ephemerons: a New Finalization Mechanism" #:title "Ephemerons: a New Finalization Mechanism"
#:location "Object-Oriented Languages, Programming, Systems, and Applications" #:location "Object-Oriented Languages, Programming, Systems, and Applications"
#:date "1997") #:date "1997")
(bib-entry #:key "Hieb90" (bib-entry #:key "Hieb90"
#:author "Robert Hieb and R. Kent Dybvig" #:author "Robert Hieb and R. Kent Dybvig"
#:title "Continuations and Concurrency" #:title "Continuations and Concurrency"
@ -187,10 +186,10 @@ The @racketmodname[racket] library combines
#:location @italic{Lisp and Symbolic Computation} #:location @italic{Lisp and Symbolic Computation}
#:date "1990") #:date "1990")
(bib-entry #:key "Sitaram93" (bib-entry #:key "Sitaram93"
#:title "Handling Control" #:title "Handling Control"
#:author "Dorai Sitaram" #:author "Dorai Sitaram"
#:location "Programming Language Design and Implementation" #:location "Programming Language Design and Implementation"
#:date "1993") #:date "1993")
(bib-entry #:key "SRFI-42" (bib-entry #:key "SRFI-42"

32
pkgs/racket-doc/scribblings/reference/stx-trans.scrbl
View File

@ -232,12 +232,11 @@ identifier, the @racket[exn:fail:contract] exception is raised.
@defproc[(local-expand [stx any/c] @defproc[(local-expand [stx any/c]
[context-v (or/c 'expression 'top-level 'module 'module-begin list?)] [context-v (or/c 'expression 'top-level 'module 'module-begin list?)]
[stop-ids (or/c (listof identifier?) (cons/c 'only (listof identifier?)) #f)] [stop-ids (or/c (listof identifier?) empty #f)]
[intdef-ctx (or/c internal-definition-context? [intdef-ctx (or/c internal-definition-context?
(listof internal-definition-context?) (listof internal-definition-context?)
#f) #f)
'()] '()])
[#:extend-stop-ids? extend-stop-ids? any/c #t])
syntax?]{ syntax?]{
Expands @racket[stx] in the lexical context of the expression Expands @racket[stx] in the lexical context of the expression
@ -260,13 +259,13 @@ The @racket[stop-ids] argument controls how far @racket[local-expand] expands @r
@racket[stop-ids] were an empty list, except that expansion does not recur to @tech{submodules} @racket[stop-ids] were an empty list, except that expansion does not recur to @tech{submodules}
defined with @racket[module*] (which are left unexpanded in the result).} defined with @racket[module*] (which are left unexpanded in the result).}
@item{If @racket[stop-ids] is any other list, then expansion proceeds recursively until the expander @item{If @racket[stop-ids] is any other list, then @racket[begin], @racket[quote], @racket[set!],
encounters any of the forms in @racket[stop-ids], and the result is the partially-expanded @racket[#%plain-lambda], @racket[case-lambda], @racket[let-values], @racket[letrec-values],
form. If @racket[extend-stop-ids?] is not @racket[#f], then @racket[begin], @racket[quote], @racket[if], @racket[begin0], @racket[with-continuation-mark], @racket[letrec-syntaxes+values],
@racket[set!], @racket[#%plain-lambda], @racket[case-lambda], @racket[let-values], @racket[#%plain-app], @racket[#%expression], @racket[#%top], and @racket[#%variable-reference]
@racket[letrec-values], @racket[if], @racket[begin0], @racket[with-continuation-mark], are implicitly added to @racket[stop-ids]. Expansion proceeds recursively, stopping when the
@racket[letrec-syntaxes+values], @racket[#%plain-app], @racket[#%expression], @racket[#%top], expander encounters any of the forms in @racket[stop-ids], and the result is the
and @racket[#%variable-reference] are implicitly added to @racket[stop-ids]. partially-expanded form.
When the expander would normally implicitly introduce a @racketid[#%app], @racketid[#%datum], When the expander would normally implicitly introduce a @racketid[#%app], @racketid[#%datum],
or @racketid[#%top] identifier as described in @secref["expand-steps"], it checks to see if an or @racketid[#%top] identifier as described in @secref["expand-steps"], it checks to see if an
@ -275,13 +274,9 @@ The @racket[stop-ids] argument controls how far @racket[local-expand] expands @r
the bare application, literal data expression, or unbound identifier rather than one wrapped in the bare application, literal data expression, or unbound identifier rather than one wrapped in
the respective explicit form. the respective explicit form.
Note that forcing recursive expansion with an identifier in @racket[stop-ids] does not When @racket[#%plain-module-begin] is not in @racket[stop-ids], the
necessarily guarantee uses of that identifier will not be expanded, since other transformers @racket[#%plain-module-begin] transformer detects and expands sub-forms (such as
may force @tech{partial expansion} by invoking @racket[local-expand] with a different value for @racket[define-values]) regardless of the identifiers presence in @racket[stop-ids].
@racket[stop-ids]. For example, the @racket[#%plain-module-begin] transformer partially expands
its sub-forms regardless of identifiers’ presence in @racket[stop-ids]. As a special case,
@racket[#%plain-module-begin] refrains from expanding @racket[module*] sub-forms if
@racket[module*] is in @racket[stop-ids].
Expansion does not replace the scopes in a local-variable Expansion does not replace the scopes in a local-variable
reference to match the binding identifier.} reference to match the binding identifier.}
@ -364,8 +359,7 @@ expansion history to external tools.
an explicit wrapper.} an explicit wrapper.}
#:changed "6.0.90.27" @elem{Loosened the contract on the @racket[intdef-ctx] argument to #:changed "6.0.90.27" @elem{Loosened the contract on the @racket[intdef-ctx] argument to
allow an empty list, which is treated the same way as allow an empty list, which is treated the same way as
@racket[#f].} @racket[#f].}]}
#:changed "7.0.0.1" @elem{Added the @racket[#:extend-stop-ids?] argument.}]}
@defproc[(syntax-local-expand-expression [stx any/c] [opaque-only? any/c #f]) @defproc[(syntax-local-expand-expression [stx any/c] [opaque-only? any/c #f])

8511
pkgs/racket-test-core/tests/racket/expobs-regression.rktd
View File

File diff suppressed because it is too large Load Diff

12
pkgs/racket-test-core/tests/racket/macro.rktl
View File

@ -482,8 +482,7 @@
(module m1-for-local-expand racket/base (module m1-for-local-expand racket/base
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(provide (rename-out [mb #%module-begin]) (provide (rename-out [mb #%module-begin])
(except-out (all-from-out racket/base) #%module-begin) (except-out (all-from-out racket/base) #%module-begin))
(for-syntax (all-from-out racket/base)))
(define-syntax (mb stx) (define-syntax (mb stx)
(syntax-case stx () (syntax-case stx ()
[(_ 10) #'(#%plain-module-begin 10)] [(_ 10) #'(#%plain-module-begin 10)]
@ -492,20 +491,17 @@
(let ([e (local-expand #'(#%plain-module-begin form ...) (let ([e (local-expand #'(#%plain-module-begin form ...)
'module-begin 'module-begin
(list #'module*))]) (list #'module*))])
(syntax-case e (module module* quote #%plain-app begin-for-syntax) (syntax-case e (module module* quote #%plain-app)
[(mod-beg [(mod-beg
(#%plain-app + (quote 1) (quote 2)) (#%plain-app + (quote 1) (quote 2))
(module* q #f 10) (module* q #f 10)
(module* z #f 11) (module* z #f 11))
(begin-for-syntax (module* r #f 12)))
'ok] 'ok]
[else (error 'test "bad local-expand result: ~s" (syntax->datum e))]) [else (error 'test "bad local-expand result: ~s" (syntax->datum e))])
e)]))) e)])))
(module m2-for-local-expand 'm1-for-local-expand (module m2-for-local-expand 'm1-for-local-expand
(+ 1 2) (+ 1 2)
(module* q #f 10) (module* q #f 10) (module* z #f 11))
(module* z #f 11)
(begin-for-syntax (module* r #f 12)))
(module uses-internal-definition-context-around-id racket/base (module uses-internal-definition-context-around-id racket/base

127
pkgs/racket-test-core/tests/racket/module.rktl
View File

@ -6,7 +6,7 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module n racket/base (module n racket/base
(define n 'n) (define n 'n)
(define-struct s (field1 field2) #:mutable) (define-struct s (field1 field2) #:mutable)
(provide n (provide n
(struct-out s) (struct-out s)
@ -355,7 +355,7 @@
(define-syntax (mb stx) (define-syntax (mb stx)
(syntax-case stx () (syntax-case stx ()
[(_ . forms) [(_ . forms)
#`(#%plain-module-begin #`(#%plain-module-begin
#,(datum->syntax stx '(require (for-syntax racket/base))) #,(datum->syntax stx '(require (for-syntax racket/base)))
. forms)]))) . forms)])))
(module m 'mod_beg2 (module m 'mod_beg2
@ -370,7 +370,7 @@
(define-syntax (mb stx) (define-syntax (mb stx)
(syntax-case stx () (syntax-case stx ()
[(_ . forms) [(_ . forms)
#`(#%plain-module-begin #`(#%plain-module-begin
#,(datum->syntax stx '(require (for-syntax racket/base))) #,(datum->syntax stx '(require (for-syntax racket/base)))
. forms)]))) . forms)])))
(module m 'mod_beg2 (module m 'mod_beg2
@ -385,7 +385,7 @@
(define-syntax (mb stx) (define-syntax (mb stx)
(syntax-case stx () (syntax-case stx ()
[(mb . forms) [(mb . forms)
#`(#%plain-module-begin #`(#%plain-module-begin
#,(datum->syntax #'mb '(require (for-syntax racket/base))) #,(datum->syntax #'mb '(require (for-syntax racket/base)))
. forms)]))) . forms)])))
(module m 'mod_beg2 (module m 'mod_beg2
@ -398,7 +398,7 @@
(module local-binding-produces-identity racket/base (module local-binding-produces-identity racket/base
(provide proc) (provide proc)
(define proc (define proc
(let () (let ()
(define-syntax identity (define-syntax identity
@ -407,7 +407,7 @@
(lambda (x) (lambda (x)
(let ([misc-id 'other]) (let ([misc-id 'other])
x))])) x))]))
(identity x)))) (identity x))))
(test 77 (dynamic-require ''local-binding-produces-identity 'proc) 77) (test 77 (dynamic-require ''local-binding-produces-identity 'proc) 77)
@ -456,7 +456,7 @@
(regexp-match? #rx"cycle" (exn-message exn))))]) (regexp-match? #rx"cycle" (exn-message exn))))])
(let-values ([(b1 tmp1 mbd1?) (split-path f1)] (let-values ([(b1 tmp1 mbd1?) (split-path f1)]
[(b2 tmp2 mbd2?) (split-path f2)]) [(b2 tmp2 mbd2?) (split-path f2)])
(with-output-to-file f1 (with-output-to-file f1
#:exists 'truncate/replace #:exists 'truncate/replace
(lambda () (lambda ()
@ -610,12 +610,12 @@
;; check collection-path details ;; check collection-path details
(test-values '(not there) (lambda () (test-values '(not there) (lambda ()
(collection-path "nonesuch" (collection-path "nonesuch"
#:fail (lambda (s) #:fail (lambda (s)
(test #t string? s) (test #t string? s)
(values 'not 'there))))) (values 'not 'there)))))
(test-values '(1 2) (lambda () (test-values '(1 2) (lambda ()
(collection-file-path "none.rkt" "nonesuch" (collection-file-path "none.rkt" "nonesuch"
#:fail (lambda (s) #:fail (lambda (s)
(test #t string? s) (test #t string? s)
(values 1 2))))) (values 1 2)))))
@ -663,9 +663,9 @@
;; Check shadowing of initial imports: ;; Check shadowing of initial imports:
(let ([m-code '(module m racket/base (define-syntax-rule (lambda . _) 5) (provide lambda))] (let ([m-code '(module m racket/base (define-syntax-rule (lambda . _) 5) (provide lambda))]
[n-code '(module n racket/base [n-code '(module n racket/base
(require 'm) (require 'm)
(define five (lambda (x) x)) (define five (lambda (x) x))
(define five-stx #'lambda) (define five-stx #'lambda)
(provide five five-stx))] (provide five five-stx))]
[p-code '(module p racket/base [p-code '(module p racket/base
@ -783,7 +783,7 @@
;; Check "source" name of built-in module: ;; Check "source" name of built-in module:
(parameterize ([current-namespace (module->namespace ''#%network)]) (parameterize ([current-namespace (module->namespace ''#%network)])
(test '#%network (test '#%network
variable-reference->module-source variable-reference->module-source
(eval (datum->syntax #'here '(#%variable-reference))))) (eval (datum->syntax #'here '(#%variable-reference)))))
@ -800,16 +800,16 @@
;; require specs ;; require specs
(parameterize ([current-namespace (make-base-namespace)]) (parameterize ([current-namespace (make-base-namespace)])
(map (map
eval eval
'((module service racket '((module service racket
(#%module-begin (#%module-begin
(module s racket/base))) (module s racket/base)))
(module good-client racket (module good-client racket
(#%module-begin (#%module-begin
(require (quote service)))) (require (quote service))))
(module another-good-client racket (module another-good-client racket
(#%module-begin (#%module-begin
(require (require
@ -817,7 +817,7 @@
[quote dynamic-in])) [quote dynamic-in]))
(require (require
(dynamic-in service)))) (dynamic-in service))))
(module also-good-client racket (module also-good-client racket
(#%module-begin (#%module-begin
(require (require
@ -825,7 +825,7 @@
[quote dynamic-in])) [quote dynamic-in]))
(require (require
(rename-in (dynamic-in service))))) (rename-in (dynamic-in service)))))
(module submodule-good-client racket (module submodule-good-client racket
(#%module-begin (#%module-begin
(require (require
@ -833,7 +833,7 @@
[quote dynamic-in])) [quote dynamic-in]))
(require (require
(rename-in (submod (dynamic-in service) s))))) (rename-in (submod (dynamic-in service) s)))))
(module another-submodule-good-client racket (module another-submodule-good-client racket
(#%module-begin (#%module-begin
(require (require
@ -907,7 +907,7 @@
(define-syntax-rule (prov) (define-syntax-rule (prov)
(provide id)) (provide id))
(prov))) (prov)))
(q go)) (q go))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -922,7 +922,7 @@
(begin (begin
(test 1 syntax-e #'one) (test 1 syntax-e #'one)
(test #t identifier? (car (syntax-property #'one 'origin))) (test #t identifier? (car (syntax-property #'one 'origin)))
(test #t symbol? (test #t symbol?
(resolved-module-path-name (resolved-module-path-name
(module-path-index-resolve (module-path-index-resolve
(car (identifier-binding (car (syntax-property #'one 'origin))))))))]) (car (identifier-binding (car (syntax-property #'one 'origin))))))))])
@ -987,7 +987,7 @@
(begin-for-syntax (begin-for-syntax
(define m1 2) (define m1 2)
(provide m1))))) (provide m1)))))
(define m2-expr (define m2-expr
'(module m2 racket/base '(module m2 racket/base
(require (for-meta -2 'm1)) (require (for-meta -2 'm1))
@ -1136,7 +1136,7 @@
#'(begin #'(begin
(require (rename-in spec [name temp])) (require (rename-in spec [name temp]))
(define-syntax name 10))))])) (define-syntax name 10))))]))
(req (only-in data/queue enqueue!)))) (req (only-in data/queue enqueue!))))
(expand-syntax (expand src))) (expand-syntax (expand src)))
@ -1265,7 +1265,7 @@
((call-with-continuation-prompt ((call-with-continuation-prompt
(lambda () (lambda ()
(call/cc values))))) (call/cc values)))))
(error "no")) (error "no"))
(err/rt-test (dynamic-require ''disallowed-definition-avoider #f) (err/rt-test (dynamic-require ''disallowed-definition-avoider #f)
@ -1466,11 +1466,11 @@ case of module-leve bindings; it doesn't cover local bindings.
(module uses-a-in-macro-rhs racket/base (module uses-a-in-macro-rhs racket/base
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(provide one) (provide one)
(define-syntax (m stx) (define-syntax (m stx)
(local-require 'provides-a-for-local-require) (local-require 'provides-a-for-local-require)
#`#,a) #`#,a)
(define one (m))) (define one (m)))
(test 1 dynamic-require ''uses-a-in-macro-rhs 'one) (test 1 dynamic-require ''uses-a-in-macro-rhs 'one)
@ -1478,16 +1478,16 @@ case of module-leve bindings; it doesn't cover local bindings.
(module uses-a-in-begin-for-syntax racket/base (module uses-a-in-begin-for-syntax racket/base
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(provide one) (provide one)
(begin-for-syntax (begin-for-syntax
(define one-ct (define one-ct
(let () (let ()
(local-require 'provides-a-for-local-require) (local-require 'provides-a-for-local-require)
a))) a)))
(define-syntax (m stx) (define-syntax (m stx)
#`#,one-ct) #`#,one-ct)
(define one (m))) (define one (m)))
(test 1 dynamic-require ''uses-a-in-begin-for-syntax 'one) (test 1 dynamic-require ''uses-a-in-begin-for-syntax 'one)
@ -1653,7 +1653,7 @@ case of module-leve bindings; it doesn't cover local bindings.
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(provide (rename-out [mb #%module-begin]) (provide (rename-out [mb #%module-begin])
(except-out (all-from-out racket/base) #%module-begin)) (except-out (all-from-out racket/base) #%module-begin))
(define-syntax (mb stx) (define-syntax (mb stx)
(syntax-case stx () (syntax-case stx ()
[(_ . b) [(_ . b)
@ -1661,7 +1661,7 @@ case of module-leve bindings; it doesn't cover local bindings.
(module use-local-require-at-phase-1 'force-local-expand-of-body (module use-local-require-at-phase-1 'force-local-expand-of-body
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(begin-for-syntax (begin-for-syntax
(local-require (only-in racket [+ ++])))) (local-require (only-in racket [+ ++]))))
@ -1847,15 +1847,15 @@ case of module-leve bindings; it doesn't cover local bindings.
`((require (rename-in racket/base [car kar]))) `((require (rename-in racket/base [car kar])))
null) null)
(define inside 7)))) (define inside 7))))
(test (not with-kar?) syntax-property m 'module-body-context-simple?) (test (not with-kar?) syntax-property m 'module-body-context-simple?)
(define i (syntax-property m 'module-body-context)) (define i (syntax-property m 'module-body-context))
(define o (syntax-property m 'module-body-inside-context)) (define o (syntax-property m 'module-body-inside-context))
(test #t syntax? i) (test #t syntax? i)
(test #t syntax? o) (test #t syntax? o)
(test car eval-syntax (datum->syntax i 'car)) (test car eval-syntax (datum->syntax i 'car))
(test 'inside cadr (identifier-binding (datum->syntax i 'inside))) (test 'inside cadr (identifier-binding (datum->syntax i 'inside)))
(test #f identifier-binding (datum->syntax o 'inside)) (test #f identifier-binding (datum->syntax o 'inside))
@ -1921,9 +1921,9 @@ case of module-leve bindings; it doesn't cover local bindings.
(module defines-a-at-two-phase-levels racket/base (module defines-a-at-two-phase-levels racket/base
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(provide a (for-syntax a)) (provide a (for-syntax a))
(define a 0) (define a 0)
(begin-for-syntax (begin-for-syntax
(define a 1))) (define a 1)))
@ -1984,7 +1984,7 @@ case of module-leve bindings; it doesn't cover local bindings.
;; this line is necessary, but you can require anything ;; this line is necessary, but you can require anything
(require (rename-in racket/base [car prefix:car])) (require (rename-in racket/base [car prefix:car]))
(module+ sub) (module+ sub)
(define my-very-own-x ,v))) (define my-very-own-x ,v)))
(eval (make-module-that-has-a-complex-renaming 10)) (eval (make-module-that-has-a-complex-renaming 10))
@ -2021,7 +2021,7 @@ case of module-leve bindings; it doesn't cover local bindings.
(test 'provide-the-x-identifier (test 'provide-the-x-identifier
resolved-module-path-name resolved-module-path-name
(module-path-index-resolve (syntax-source-module (module-path-index-resolve (syntax-source-module
(namespace-syntax-introduce (namespace-syntax-introduce
(dynamic-require ''provide-the-x-identifier 'x-id)))))) (dynamic-require ''provide-the-x-identifier 'x-id))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -2048,7 +2048,7 @@ case of module-leve bindings; it doesn't cover local bindings.
(module m-that-defines-very-confused-x racket (module m-that-defines-very-confused-x racket
;; this line is necessary, but you can require anything ;; this line is necessary, but you can require anything
;;(require (only-in racket/base)) ;;(require (only-in racket/base))
(define very-confused-x 10)) (define very-confused-x 10))
(require 'm-that-defines-very-confused-x) (require 'm-that-defines-very-confused-x)
@ -2151,11 +2151,11 @@ case of module-leve bindings; it doesn't cover local bindings.
(module uses-defines-a-variable-x-in-its-body-at-phase-1 racket/base (module uses-defines-a-variable-x-in-its-body-at-phase-1 racket/base
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(provide out) (provide out)
(define-syntax (m stx) (define-syntax (m stx)
(dynamic-require ''defines-a-variable-x-in-its-body #f) (dynamic-require ''defines-a-variable-x-in-its-body #f)
#`(quote #,(eval 'x (module->namespace ''defines-a-variable-x-in-its-body)))) #`(quote #,(eval 'x (module->namespace ''defines-a-variable-x-in-its-body))))
(define out (m))) (define out (m)))
(test 'defined dynamic-require ''uses-defines-a-variable-x-in-its-body-at-phase-1 'out) (test 'defined dynamic-require ''uses-defines-a-variable-x-in-its-body-at-phase-1 'out)
@ -2210,9 +2210,9 @@ case of module-leve bindings; it doesn't cover local bindings.
(parameterize ([current-namespace (make-base-namespace)]) (parameterize ([current-namespace (make-base-namespace)])
(eval '(module m racket (eval '(module m racket
(require syntax/parse/define) (require syntax/parse/define)
(define-simple-macro (f m:id) (define-simple-macro (f m:id)
(begin (begin
(define-for-syntax x "prop value") (define-for-syntax x "prop value")
@ -2276,7 +2276,7 @@ case of module-leve bindings; it doesn't cover local bindings.
(define a1 'a1) (define a1 'a1)
(define a2 'a2) (define a2 'a2)
(define a3 'a3)) (define a3 'a3))
(require (prefix-in a: 'a)) (require (prefix-in a: 'a))
(define another 'x)) (define another 'x))
@ -2336,7 +2336,7 @@ case of module-leve bindings; it doesn't cover local bindings.
(require (for-syntax 'check-shadowing-in-other-phase-d)) (require (for-syntax 'check-shadowing-in-other-phase-d))
(provide (all-from-out 'check-shadowing-in-other-phase-c) (provide (all-from-out 'check-shadowing-in-other-phase-c)
(for-syntax (all-from-out 'check-shadowing-in-other-phase-d)))) (for-syntax (all-from-out 'check-shadowing-in-other-phase-d))))
(module check-shadowing-in-other-phase-a racket/base (module check-shadowing-in-other-phase-a racket/base
(require 'check-shadowing-in-other-phase-b) (require 'check-shadowing-in-other-phase-b)
b) b)
@ -2675,11 +2675,11 @@ case of module-leve bindings; it doesn't cover local bindings.
(module uses-eval-at-compile-time racket/base (module uses-eval-at-compile-time racket/base
(require (for-syntax racket/base) (require (for-syntax racket/base)
(for-meta 2 racket/base)) (for-meta 2 racket/base))
(define-syntax (ct-eval stx) (define-syntax (ct-eval stx)
(syntax-case stx () (syntax-case stx ()
[(_ e) #`'#,(eval #'e)])) [(_ e) #`'#,(eval #'e)]))
(ct-eval (+ 1 2))) (ct-eval (+ 1 2)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -2702,37 +2702,6 @@ case of module-leve bindings; it doesn't cover local bindings.
(test '(new orig) dynamic-require ''mixes-top-level-namespaces 'result) (test '(new orig) dynamic-require ''mixes-top-level-namespaces 'result)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; `local-expand` with `#:extend-stop-ids? #f` expands through core forms
(err/rt-test
(eval
'(module local-expand-with-only-stop-list racket/base
(require (for-syntax racket/base))
(define-syntax (stop stx)
(syntax-case stx ()
[(_ form) #'form]))
(define-syntax (m stx)
(syntax-case stx ()
[(_ form)
(local-expand #'form 'expression (list #'stop) #:extend-stop-ids? #f)]))
(m (let-syntax ([plus (make-rename-transformer #'+)])
(stop (plus 1 2))))))
exn:fail?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure #%module-begin respects the stop list when module* is present
(module module-begin-stop-list racket/base
(require (for-syntax racket/base))
(define-syntax (stop stx)
(raise-syntax-error #f "don't expand me!" stx))
(begin-for-syntax
(local-expand #'(#%plain-module-begin (#%expression (stop)))
'module-begin
(list #'module* #'stop)
#:extend-stop-ids? #f)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure that re-expansion of a `(module _name #f ....)` ;; Make sure that re-expansion of a `(module _name #f ....)`
;; submodule doesn't lose track of the base scope of the ;; submodule doesn't lose track of the base scope of the

4
racket/collects/racket/private/base.rkt
View File

@ -12,7 +12,6 @@
"cert.rkt" "cert.rkt"
"submodule.rkt" "submodule.rkt"
"generic-interfaces.rkt" "generic-interfaces.rkt"
"kw-syntax-local.rkt" ; shadows `local-expand` and variants
"kw-syntax-binding.rkt" ; shadows `syntax-binding-set-extend` "kw-syntax-binding.rkt" ; shadows `syntax-binding-set-extend`
(for-syntax "stxcase-scheme.rkt")) (for-syntax "stxcase-scheme.rkt"))
@ -30,7 +29,7 @@
struct struct
(all-from-except "hash.rkt" paired-fold) (all-from-except "hash.rkt" paired-fold)
(all-from "list.rkt") (all-from "list.rkt")
(all-from-except "string.rkt" (all-from-except "string.rkt"
-regexp-replace*) -regexp-replace*)
(rename -regexp-replace* regexp-replace*) (rename -regexp-replace* regexp-replace*)
identifier? identifier?
@ -40,7 +39,6 @@
(all-from "cert.rkt") (all-from "cert.rkt")
(all-from "submodule.rkt") (all-from "submodule.rkt")
(all-from "generic-interfaces.rkt") (all-from "generic-interfaces.rkt")
(all-from "kw-syntax-local.rkt")
(all-from "kw-syntax-binding.rkt") (all-from "kw-syntax-binding.rkt")
(for-syntax syntax-rules syntax-id-rules ... _) (for-syntax syntax-rules syntax-id-rules ... _)
(rename -open-input-file open-input-file) (rename -open-input-file open-input-file)

2
racket/collects/racket/private/kw-syntax-binding.rkt
View File

@ -1,4 +1,4 @@
(module kw-syntax-local "pre-base.rkt" (module kw-syntax-binding "pre-base.rkt"
(require (prefix-in k: '#%kernel)) (require (prefix-in k: '#%kernel))
(provide syntax-binding-set-extend) (provide syntax-binding-set-extend)

24
racket/collects/racket/private/kw-syntax-local.rkt
View File

@ -1,24 +0,0 @@
(module kw-syntax-local "pre-base.rkt"
(require (prefix-in k: '#%kernel))
(provide local-expand
local-expand/capture-lifts
local-transformer-expand
local-transformer-expand/capture-lifts)
(define (local-expand s context stop-ids [intdefs '()]
#:extend-stop-ids? [extend-stop-ids? #t])
(k:local-expand s context stop-ids intdefs extend-stop-ids?))
(define (local-expand/capture-lifts s context stop-ids [intdefs '()] [lift-key (gensym 'lift)]
#:extend-stop-ids? [extend-stop-ids? #t])
(k:local-expand/capture-lifts s context stop-ids intdefs lift-key extend-stop-ids?))
(define (local-transformer-expand s context stop-ids [intdefs '()]
#:extend-stop-ids? [extend-stop-ids? #t])
(k:local-transformer-expand s context stop-ids intdefs extend-stop-ids?))
(define (local-transformer-expand/capture-lifts
s context stop-ids [intdefs '()] [lift-key (gensym 'lift)]
#:extend-stop-ids? [extend-stop-ids? #t])
(k:local-transformer-expand/capture-lifts s context stop-ids intdefs lift-key extend-stop-ids?)))

9
racket/src/expander/expand/definition-context.rkt
View File

@ -222,7 +222,6 @@
#:phase [phase (expand-context-phase ctx)] #:phase [phase (expand-context-phase ctx)]
#:intdefs intdefs #:intdefs intdefs
#:stop-ids [stop-ids #f] #:stop-ids [stop-ids #f]
#:extend-stops? [extend-stops? #t]
#:to-parsed-ok? [to-parsed-ok? #f] #:to-parsed-ok? [to-parsed-ok? #f]
#:track-to-be-defined? [track-to-be-defined? #f] #:track-to-be-defined? [track-to-be-defined? #f]
#:keep-#%expression? [keep-#%expression? #t]) #:keep-#%expression? [keep-#%expression? #t])
@ -230,11 +229,7 @@
(expand-context-context ctx)) (expand-context-context ctx))
(and (list? context) (and (list? context)
(list? (expand-context-context ctx))))) (list? (expand-context-context ctx)))))
(define all-stop-ids (if stop-ids (define all-stop-ids (and stop-ids (stop-ids->all-stop-ids stop-ids phase)))
(if extend-stops?
(stop-ids->all-stop-ids stop-ids phase)
stop-ids)
null))
(define def-ctx-scopes (if (expand-context-def-ctx-scopes ctx) (define def-ctx-scopes (if (expand-context-def-ctx-scopes ctx)
(unbox (expand-context-def-ctx-scopes ctx)) (unbox (expand-context-def-ctx-scopes ctx))
null)) null))
@ -280,7 +275,7 @@
[just-once? #f] [just-once? #f]
[in-local-expand? #t] [in-local-expand? #t]
[keep-#%expression? keep-#%expression?] [keep-#%expression? keep-#%expression?]
[stops (free-id-set phase all-stop-ids)] [stops (free-id-set phase (or all-stop-ids null))]
[current-introduction-scopes null] [current-introduction-scopes null]
[need-eventually-defined (let ([ht (expand-context-need-eventually-defined ctx)]) [need-eventually-defined (let ([ht (expand-context-need-eventually-defined ctx)])
(cond (cond

4
racket/src/expander/expand/expr.rkt
View File

@ -678,9 +678,7 @@
(rebuild (rebuild
rebuild-s rebuild-s
(list (m 'set!) (list (m 'set!)
(substitute-variable id t #:no-stops? (free-id-set-empty-or-just-module*? (substitute-variable id t #:no-stops? (free-id-set-empty-or-just-module*? (expand-context-stops ctx)))
(expand-context-stops ctx)
(expand-context-phase ctx)))
exp-rhs)))] exp-rhs)))]
[(not binding) [(not binding)
(raise-unbound-syntax-error #f "unbound identifier" s id null (raise-unbound-syntax-error #f "unbound identifier" s id null

14
racket/src/expander/expand/free-id-set.rkt
View File

@ -1,9 +1,7 @@
#lang racket/base #lang racket/base
(require "../common/list-ish.rkt" (require "../common/list-ish.rkt"
"../syntax/binding.rkt"
"../syntax/syntax.rkt" "../syntax/syntax.rkt"
"../syntax/scope.rkt" "../syntax/binding.rkt")
"../namespace/core.rkt")
(provide free-id-set (provide free-id-set
empty-free-id-set empty-free-id-set
@ -31,10 +29,8 @@
null))]) null))])
(free-identifier=? id given-id phase phase)))) (free-identifier=? id given-id phase phase))))
(define (free-id-set-empty-or-just-module*? fs phase) (define (free-id-set-empty-or-just-module*? fs)
(define c (hash-count fs)) (define c (hash-count fs))
(or (zero? c) ;; If any identifier other than `module*` is present, then many
(and (= 1 c) ;; identifiers are present
(let* ([p-core-stx (syntax-shift-phase-level core-stx phase)] (c . <= . 1))
[mod-star-stx (datum->syntax p-core-stx 'module*)])
(free-identifier=? (car (hash-values fs)) mod-star-stx phase phase)))))

18
racket/src/expander/expand/local-expand.rkt
View File

@ -23,26 +23,22 @@
local-transformer-expand/capture-lifts local-transformer-expand/capture-lifts
syntax-local-expand-expression) syntax-local-expand-expression)
(define (local-expand s context stop-ids [intdefs '()] [extend-stops? #t]) (define (local-expand s context stop-ids [intdefs '()])
(do-local-expand 'local-expand s context stop-ids intdefs (do-local-expand 'local-expand s context stop-ids intdefs))
#:extend-stops? extend-stops?))
(define (local-expand/capture-lifts s context stop-ids [intdefs '()] [lift-key (generate-lift-key)] [extend-stops? #t]) (define (local-expand/capture-lifts s context stop-ids [intdefs '()] [lift-key (generate-lift-key)])
(do-local-expand 'local-expand s context stop-ids intdefs (do-local-expand 'local-expand s context stop-ids intdefs
#:capture-lifts? #t #:capture-lifts? #t
#:extend-stops? extend-stops?
#:lift-key lift-key)) #:lift-key lift-key))
(define (local-transformer-expand s context stop-ids [intdefs '()] [extend-stops? #t]) (define (local-transformer-expand s context stop-ids [intdefs '()])
(do-local-expand 'local-expand s context stop-ids intdefs (do-local-expand 'local-expand s context stop-ids intdefs
#:as-transformer? #t #:as-transformer? #t))
#:extend-stops? extend-stops?))
(define (local-transformer-expand/capture-lifts s context stop-ids [intdefs '()] [lift-key (generate-lift-key)] [extend-stops? #t]) (define (local-transformer-expand/capture-lifts s context stop-ids [intdefs '()] [lift-key (generate-lift-key)])
(do-local-expand 'local-expand s context stop-ids intdefs (do-local-expand 'local-expand s context stop-ids intdefs
#:as-transformer? #t #:as-transformer? #t
#:capture-lifts? #t #:capture-lifts? #t
#:extend-stops? extend-stops?
#:lift-key lift-key)) #:lift-key lift-key))
(define (syntax-local-expand-expression s [opaque-only? #f]) (define (syntax-local-expand-expression s [opaque-only? #f])
@ -72,7 +68,6 @@
(define (do-local-expand who s-or-s-exp context stop-ids [intdefs '()] (define (do-local-expand who s-or-s-exp context stop-ids [intdefs '()]
#:capture-lifts? [capture-lifts? #f] #:capture-lifts? [capture-lifts? #f]
#:as-transformer? [as-transformer? #f] #:as-transformer? [as-transformer? #f]
#:extend-stops? [extend-stops? #t]
#:to-parsed-ok? [to-parsed-ok? #f] #:to-parsed-ok? [to-parsed-ok? #f]
#:keep-#%expression? [keep-#%expression? #t] #:keep-#%expression? [keep-#%expression? #t]
#:lift-key [lift-key (and (or capture-lifts? #:lift-key [lift-key (and (or capture-lifts?
@ -109,7 +104,6 @@
#:phase phase #:phase phase
#:intdefs intdefs #:intdefs intdefs
#:stop-ids stop-ids #:stop-ids stop-ids
#:extend-stops? extend-stops?
#:to-parsed-ok? to-parsed-ok? #:to-parsed-ok? to-parsed-ok?
#:keep-#%expression? (or keep-#%expression? #:keep-#%expression? (or keep-#%expression?
(and (expand-context-in-local-expand? ctx) (and (expand-context-in-local-expand? ctx)

7
racket/src/expander/expand/main.rkt
View File

@ -340,9 +340,7 @@
;; A reference to a variable expands to itself ;; A reference to a variable expands to itself
(register-variable-referenced-if-local! binding) (register-variable-referenced-if-local! binding)
;; If the variable is locally bound, replace the use's scopes with the binding's scopes ;; If the variable is locally bound, replace the use's scopes with the binding's scopes
(define result-s (substitute-variable id t #:no-stops? (free-id-set-empty-or-just-module*? (define result-s (substitute-variable id t #:no-stops? (free-id-set-empty-or-just-module*? (expand-context-stops ctx))))
(expand-context-stops ctx)
(expand-context-phase ctx))))
(cond (cond
[(and (expand-context-to-parsed? ctx) [(and (expand-context-to-parsed? ctx)
(free-id-set-empty? (expand-context-stops ctx))) (free-id-set-empty? (expand-context-stops ctx)))
@ -409,8 +407,7 @@
(log-expand ctx 'macro-pre-x cleaned-s) (log-expand ctx 'macro-pre-x cleaned-s)
(define confine-def-ctx-scopes? (define confine-def-ctx-scopes?
(not (or (expand-context-only-immediate? ctx) (not (or (expand-context-only-immediate? ctx)
(not (free-id-set-empty-or-just-module*? (expand-context-stops ctx) (not (free-id-set-empty-or-just-module*? (expand-context-stops ctx))))))
(expand-context-phase ctx))))))
(define accum-ctx (define accum-ctx
(if (and confine-def-ctx-scopes? (if (and confine-def-ctx-scopes?
(expand-context-def-ctx-scopes ctx) (expand-context-def-ctx-scopes ctx)

9
racket/src/expander/expand/module.rkt
View File

@ -296,7 +296,7 @@
;; Passes 1 and 2 are nested via `begin-for-syntax`: ;; Passes 1 and 2 are nested via `begin-for-syntax`:
(define expression-expanded-bodys (define expression-expanded-bodys
(let pass-1-and-2-loop ([bodys bodys] [phase phase] [keep-stops? (stop-at-module*? ctx)]) (let pass-1-and-2-loop ([bodys bodys] [phase phase])
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;; Pass 1: partially expand to discover all bindings and install all ;; Pass 1: partially expand to discover all bindings and install all
@ -305,6 +305,7 @@
;; Need to accumulate definition contexts created during ;; Need to accumulate definition contexts created during
;; partial expansion: ;; partial expansion:
(define def-ctx-scopes (box null)) (define def-ctx-scopes (box null))
(define to-parsed? (expand-context-to-parsed? ctx))
(define partial-body-ctx (struct*-copy expand-context ctx (define partial-body-ctx (struct*-copy expand-context ctx
[context 'module] [context 'module]
@ -355,9 +356,7 @@
(log-expand partial-body-ctx 'next-group) (log-expand partial-body-ctx 'next-group)
(define body-ctx (struct*-copy expand-context (accumulate-def-ctx-scopes partial-body-ctx def-ctx-scopes) (define body-ctx (struct*-copy expand-context (accumulate-def-ctx-scopes partial-body-ctx def-ctx-scopes)
[stops (if keep-stops? [stops empty-free-id-set]
(expand-context-stops ctx)
empty-free-id-set)]
[def-ctx-scopes #f] [def-ctx-scopes #f]
[post-expansion #:parent root-expand-context #f] [post-expansion #:parent root-expand-context #f]
[to-module-lifts (make-to-module-lift-context phase [to-module-lifts (make-to-module-lift-context phase
@ -757,7 +756,7 @@
(prepare-next-phase-namespace partial-body-ctx) (prepare-next-phase-namespace partial-body-ctx)
(log-expand partial-body-ctx 'phase-up) (log-expand partial-body-ctx 'phase-up)
(define-match m disarmed-exp-body '(begin-for-syntax e ...)) (define-match m disarmed-exp-body '(begin-for-syntax e ...))
(define nested-bodys (pass-1-and-2-loop (m 'e) (add1 phase) #f)) (define nested-bodys (pass-1-and-2-loop (m 'e) (add1 phase)))
(log-expand partial-body-ctx 'next-group) (log-expand partial-body-ctx 'next-group)
(namespace-run-available-modules! m-ns (add1 phase)) ; to support running `begin-for-syntax` (namespace-run-available-modules! m-ns (add1 phase)) ; to support running `begin-for-syntax`
(eval-nested-bodys nested-bodys (add1 phase) ct-m-ns self partial-body-ctx) (eval-nested-bodys nested-bodys (add1 phase) ct-m-ns self partial-body-ctx)

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "7.0.0.19" #define MZSCHEME_VERSION "7.0.0.20"
#define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 19 #define MZSCHEME_VERSION_W 20
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

1427
racket/src/racket/src/startup.inc
View File

File diff suppressed because it is too large Load Diff