Revert "Allow local-expand to opt-out of implicit extension of the stop list"
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
parent
5be4109495
commit
6b56156d55
|
|
@ -12,7 +12,7 @@
|
|||
|
||||
(define collection 'multi)
|
||||
|
||||
(define version "7.0.0.19")
|
||||
(define version "7.0.0.20")
|
||||
|
||||
(define deps `("racket-lib"
|
||||
["racket" #:version ,version]))
|
||||
|
|
|
|||
|
|
@ -46,7 +46,6 @@ language.
|
|||
racket/private/stx
|
||||
racket/private/map
|
||||
racket/private/list
|
||||
racket/private/kw-syntax-local
|
||||
racket/private/base)]{
|
||||
|
||||
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)"
|
||||
#:date "2002")
|
||||
|
||||
(bib-entry #:key "Friedman95"
|
||||
#:title "Exception system proposal"
|
||||
#:author "Daniel P. Friedman, C. T. Haynes, and R. Kent Dybvig"
|
||||
(bib-entry #:key "Friedman95"
|
||||
#:title "Exception system proposal"
|
||||
#:author "Daniel P. Friedman, C. T. Haynes, and R. Kent Dybvig"
|
||||
#:location "web page"
|
||||
#:url "http://www.cs.indiana.edu/scheme-repository/doc.proposals.exceptions.html"
|
||||
#:date "1995")
|
||||
|
||||
(bib-entry #:key "Gasbichler02"
|
||||
#:title "Processes vs. User-Level Threads in Scsh"
|
||||
#:author "Martin Gasbichler and Michael Sperber"
|
||||
(bib-entry #:key "Gasbichler02"
|
||||
#:title "Processes vs. User-Level Threads in Scsh"
|
||||
#:author "Martin Gasbichler and Michael Sperber"
|
||||
#:date "2002"
|
||||
#:location "Workshop on Scheme and Functional Programming")
|
||||
|
||||
|
|
@ -144,13 +143,13 @@ The @racketmodname[racket] library combines
|
|||
#:title "Engines Build Process Abstractions"
|
||||
#:location "Symposium on LISP and Functional Programming"
|
||||
#:date "1984")
|
||||
|
||||
|
||||
(bib-entry #:key "Hayes97"
|
||||
#:author "Barry Hayes"
|
||||
#:title "Ephemerons: a New Finalization Mechanism"
|
||||
#:location "Object-Oriented Languages, Programming, Systems, and Applications"
|
||||
#:date "1997")
|
||||
|
||||
|
||||
(bib-entry #:key "Hieb90"
|
||||
#:author "Robert Hieb and R. Kent Dybvig"
|
||||
#:title "Continuations and Concurrency"
|
||||
|
|
@ -187,10 +186,10 @@ The @racketmodname[racket] library combines
|
|||
#:location @italic{Lisp and Symbolic Computation}
|
||||
#:date "1990")
|
||||
|
||||
(bib-entry #:key "Sitaram93"
|
||||
#:title "Handling Control"
|
||||
(bib-entry #:key "Sitaram93"
|
||||
#:title "Handling Control"
|
||||
#:author "Dorai Sitaram"
|
||||
#:location "Programming Language Design and Implementation"
|
||||
#:location "Programming Language Design and Implementation"
|
||||
#:date "1993")
|
||||
|
||||
(bib-entry #:key "SRFI-42"
|
||||
|
|
|
|||
|
|
@ -232,12 +232,11 @@ identifier, the @racket[exn:fail:contract] exception is raised.
|
|||
|
||||
@defproc[(local-expand [stx any/c]
|
||||
[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?
|
||||
(listof internal-definition-context?)
|
||||
#f)
|
||||
'()]
|
||||
[#:extend-stop-ids? extend-stop-ids? any/c #t])
|
||||
'()])
|
||||
syntax?]{
|
||||
|
||||
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}
|
||||
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
|
||||
encounters any of the forms in @racket[stop-ids], and the result is the partially-expanded
|
||||
form. If @racket[extend-stop-ids?] is not @racket[#f], then @racket[begin], @racket[quote],
|
||||
@racket[set!], @racket[#%plain-lambda], @racket[case-lambda], @racket[let-values],
|
||||
@racket[letrec-values], @racket[if], @racket[begin0], @racket[with-continuation-mark],
|
||||
@racket[letrec-syntaxes+values], @racket[#%plain-app], @racket[#%expression], @racket[#%top],
|
||||
and @racket[#%variable-reference] are implicitly added to @racket[stop-ids].
|
||||
@item{If @racket[stop-ids] is any other list, then @racket[begin], @racket[quote], @racket[set!],
|
||||
@racket[#%plain-lambda], @racket[case-lambda], @racket[let-values], @racket[letrec-values],
|
||||
@racket[if], @racket[begin0], @racket[with-continuation-mark], @racket[letrec-syntaxes+values],
|
||||
@racket[#%plain-app], @racket[#%expression], @racket[#%top], and @racket[#%variable-reference]
|
||||
are implicitly added to @racket[stop-ids]. Expansion proceeds recursively, stopping when the
|
||||
expander encounters any of the forms in @racket[stop-ids], and the result is the
|
||||
partially-expanded form.
|
||||
|
||||
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
|
||||
|
|
@ -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 respective explicit form.
|
||||
|
||||
Note that forcing recursive expansion with an identifier in @racket[stop-ids] does not
|
||||
necessarily guarantee uses of that identifier will not be expanded, since other transformers
|
||||
may force @tech{partial expansion} by invoking @racket[local-expand] with a different value for
|
||||
@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].
|
||||
When @racket[#%plain-module-begin] is not in @racket[stop-ids], the
|
||||
@racket[#%plain-module-begin] transformer detects and expands sub-forms (such as
|
||||
@racket[define-values]) regardless of the identifiers presence in @racket[stop-ids].
|
||||
|
||||
Expansion does not replace the scopes in a local-variable
|
||||
reference to match the binding identifier.}
|
||||
|
|
@ -364,8 +359,7 @@ expansion history to external tools.
|
|||
an explicit wrapper.}
|
||||
#: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
|
||||
@racket[#f].}
|
||||
#:changed "7.0.0.1" @elem{Added the @racket[#:extend-stop-ids?] argument.}]}
|
||||
@racket[#f].}]}
|
||||
|
||||
|
||||
@defproc[(syntax-local-expand-expression [stx any/c] [opaque-only? any/c #f])
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -482,8 +482,7 @@
|
|||
(module m1-for-local-expand racket/base
|
||||
(require (for-syntax racket/base))
|
||||
(provide (rename-out [mb #%module-begin])
|
||||
(except-out (all-from-out racket/base) #%module-begin)
|
||||
(for-syntax (all-from-out racket/base)))
|
||||
(except-out (all-from-out racket/base) #%module-begin))
|
||||
(define-syntax (mb stx)
|
||||
(syntax-case stx ()
|
||||
[(_ 10) #'(#%plain-module-begin 10)]
|
||||
|
|
@ -492,20 +491,17 @@
|
|||
(let ([e (local-expand #'(#%plain-module-begin form ...)
|
||||
'module-begin
|
||||
(list #'module*))])
|
||||
(syntax-case e (module module* quote #%plain-app begin-for-syntax)
|
||||
(syntax-case e (module module* quote #%plain-app)
|
||||
[(mod-beg
|
||||
(#%plain-app + (quote 1) (quote 2))
|
||||
(module* q #f 10)
|
||||
(module* z #f 11)
|
||||
(begin-for-syntax (module* r #f 12)))
|
||||
(module* z #f 11))
|
||||
'ok]
|
||||
[else (error 'test "bad local-expand result: ~s" (syntax->datum e))])
|
||||
e)])))
|
||||
(module m2-for-local-expand 'm1-for-local-expand
|
||||
(+ 1 2)
|
||||
(module* q #f 10)
|
||||
(module* z #f 11)
|
||||
(begin-for-syntax (module* r #f 12)))
|
||||
(module* q #f 10) (module* z #f 11))
|
||||
|
||||
|
||||
(module uses-internal-definition-context-around-id racket/base
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module n racket/base
|
||||
(define n 'n)
|
||||
(define n 'n)
|
||||
(define-struct s (field1 field2) #:mutable)
|
||||
(provide n
|
||||
(struct-out s)
|
||||
|
|
@ -355,7 +355,7 @@
|
|||
(define-syntax (mb stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . forms)
|
||||
#`(#%plain-module-begin
|
||||
#`(#%plain-module-begin
|
||||
#,(datum->syntax stx '(require (for-syntax racket/base)))
|
||||
. forms)])))
|
||||
(module m 'mod_beg2
|
||||
|
|
@ -370,7 +370,7 @@
|
|||
(define-syntax (mb stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . forms)
|
||||
#`(#%plain-module-begin
|
||||
#`(#%plain-module-begin
|
||||
#,(datum->syntax stx '(require (for-syntax racket/base)))
|
||||
. forms)])))
|
||||
(module m 'mod_beg2
|
||||
|
|
@ -385,7 +385,7 @@
|
|||
(define-syntax (mb stx)
|
||||
(syntax-case stx ()
|
||||
[(mb . forms)
|
||||
#`(#%plain-module-begin
|
||||
#`(#%plain-module-begin
|
||||
#,(datum->syntax #'mb '(require (for-syntax racket/base)))
|
||||
. forms)])))
|
||||
(module m 'mod_beg2
|
||||
|
|
@ -398,7 +398,7 @@
|
|||
|
||||
(module local-binding-produces-identity racket/base
|
||||
(provide proc)
|
||||
|
||||
|
||||
(define proc
|
||||
(let ()
|
||||
(define-syntax identity
|
||||
|
|
@ -407,7 +407,7 @@
|
|||
(lambda (x)
|
||||
(let ([misc-id 'other])
|
||||
x))]))
|
||||
|
||||
|
||||
(identity x))))
|
||||
|
||||
(test 77 (dynamic-require ''local-binding-produces-identity 'proc) 77)
|
||||
|
|
@ -456,7 +456,7 @@
|
|||
(regexp-match? #rx"cycle" (exn-message exn))))])
|
||||
(let-values ([(b1 tmp1 mbd1?) (split-path f1)]
|
||||
[(b2 tmp2 mbd2?) (split-path f2)])
|
||||
|
||||
|
||||
(with-output-to-file f1
|
||||
#:exists 'truncate/replace
|
||||
(lambda ()
|
||||
|
|
@ -610,12 +610,12 @@
|
|||
;; check collection-path details
|
||||
|
||||
(test-values '(not there) (lambda ()
|
||||
(collection-path "nonesuch"
|
||||
#:fail (lambda (s)
|
||||
(collection-path "nonesuch"
|
||||
#:fail (lambda (s)
|
||||
(test #t string? s)
|
||||
(values 'not 'there)))))
|
||||
(test-values '(1 2) (lambda ()
|
||||
(collection-file-path "none.rkt" "nonesuch"
|
||||
(collection-file-path "none.rkt" "nonesuch"
|
||||
#:fail (lambda (s)
|
||||
(test #t string? s)
|
||||
(values 1 2)))))
|
||||
|
|
@ -663,9 +663,9 @@
|
|||
;; Check shadowing of initial imports:
|
||||
|
||||
(let ([m-code '(module m racket/base (define-syntax-rule (lambda . _) 5) (provide lambda))]
|
||||
[n-code '(module n racket/base
|
||||
(require 'm)
|
||||
(define five (lambda (x) x))
|
||||
[n-code '(module n racket/base
|
||||
(require 'm)
|
||||
(define five (lambda (x) x))
|
||||
(define five-stx #'lambda)
|
||||
(provide five five-stx))]
|
||||
[p-code '(module p racket/base
|
||||
|
|
@ -783,7 +783,7 @@
|
|||
;; Check "source" name of built-in module:
|
||||
|
||||
(parameterize ([current-namespace (module->namespace ''#%network)])
|
||||
(test '#%network
|
||||
(test '#%network
|
||||
variable-reference->module-source
|
||||
(eval (datum->syntax #'here '(#%variable-reference)))))
|
||||
|
||||
|
|
@ -800,16 +800,16 @@
|
|||
;; require specs
|
||||
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(map
|
||||
(map
|
||||
eval
|
||||
'((module service racket
|
||||
(#%module-begin
|
||||
(module s racket/base)))
|
||||
|
||||
|
||||
(module good-client racket
|
||||
(#%module-begin
|
||||
(require (quote service))))
|
||||
|
||||
|
||||
(module another-good-client racket
|
||||
(#%module-begin
|
||||
(require
|
||||
|
|
@ -817,7 +817,7 @@
|
|||
[quote dynamic-in]))
|
||||
(require
|
||||
(dynamic-in service))))
|
||||
|
||||
|
||||
(module also-good-client racket
|
||||
(#%module-begin
|
||||
(require
|
||||
|
|
@ -825,7 +825,7 @@
|
|||
[quote dynamic-in]))
|
||||
(require
|
||||
(rename-in (dynamic-in service)))))
|
||||
|
||||
|
||||
(module submodule-good-client racket
|
||||
(#%module-begin
|
||||
(require
|
||||
|
|
@ -833,7 +833,7 @@
|
|||
[quote dynamic-in]))
|
||||
(require
|
||||
(rename-in (submod (dynamic-in service) s)))))
|
||||
|
||||
|
||||
(module another-submodule-good-client racket
|
||||
(#%module-begin
|
||||
(require
|
||||
|
|
@ -907,7 +907,7 @@
|
|||
(define-syntax-rule (prov)
|
||||
(provide id))
|
||||
(prov)))
|
||||
|
||||
|
||||
(q go))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -922,7 +922,7 @@
|
|||
(begin
|
||||
(test 1 syntax-e #'one)
|
||||
(test #t identifier? (car (syntax-property #'one 'origin)))
|
||||
(test #t symbol?
|
||||
(test #t symbol?
|
||||
(resolved-module-path-name
|
||||
(module-path-index-resolve
|
||||
(car (identifier-binding (car (syntax-property #'one 'origin))))))))])
|
||||
|
|
@ -987,7 +987,7 @@
|
|||
(begin-for-syntax
|
||||
(define m1 2)
|
||||
(provide m1)))))
|
||||
|
||||
|
||||
(define m2-expr
|
||||
'(module m2 racket/base
|
||||
(require (for-meta -2 'm1))
|
||||
|
|
@ -1136,7 +1136,7 @@
|
|||
#'(begin
|
||||
(require (rename-in spec [name temp]))
|
||||
(define-syntax name 10))))]))
|
||||
|
||||
|
||||
(req (only-in data/queue enqueue!))))
|
||||
(expand-syntax (expand src)))
|
||||
|
||||
|
|
@ -1265,7 +1265,7 @@
|
|||
((call-with-continuation-prompt
|
||||
(lambda ()
|
||||
(call/cc values)))))
|
||||
|
||||
|
||||
(error "no"))
|
||||
|
||||
(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
|
||||
(require (for-syntax racket/base))
|
||||
(provide one)
|
||||
|
||||
|
||||
(define-syntax (m stx)
|
||||
(local-require 'provides-a-for-local-require)
|
||||
#`#,a)
|
||||
|
||||
|
||||
(define one (m)))
|
||||
|
||||
(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
|
||||
(require (for-syntax racket/base))
|
||||
(provide one)
|
||||
|
||||
|
||||
(begin-for-syntax
|
||||
(define one-ct
|
||||
(let ()
|
||||
(local-require 'provides-a-for-local-require)
|
||||
a)))
|
||||
|
||||
|
||||
(define-syntax (m stx)
|
||||
#`#,one-ct)
|
||||
|
||||
|
||||
(define one (m)))
|
||||
|
||||
(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))
|
||||
(provide (rename-out [mb #%module-begin])
|
||||
(except-out (all-from-out racket/base) #%module-begin))
|
||||
|
||||
|
||||
(define-syntax (mb stx)
|
||||
(syntax-case stx ()
|
||||
[(_ . 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
|
||||
(require (for-syntax racket/base))
|
||||
|
||||
|
||||
(begin-for-syntax
|
||||
(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])))
|
||||
null)
|
||||
(define inside 7))))
|
||||
|
||||
|
||||
(test (not with-kar?) syntax-property m 'module-body-context-simple?)
|
||||
|
||||
(define i (syntax-property m 'module-body-context))
|
||||
(define o (syntax-property m 'module-body-inside-context))
|
||||
|
||||
|
||||
(test #t syntax? i)
|
||||
(test #t syntax? o)
|
||||
|
||||
|
||||
(test car eval-syntax (datum->syntax i 'car))
|
||||
(test 'inside cadr (identifier-binding (datum->syntax i '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
|
||||
(require (for-syntax racket/base))
|
||||
|
||||
|
||||
(provide a (for-syntax a))
|
||||
|
||||
|
||||
(define a 0)
|
||||
(begin-for-syntax
|
||||
(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
|
||||
(require (rename-in racket/base [car prefix:car]))
|
||||
(module+ sub)
|
||||
|
||||
|
||||
(define my-very-own-x ,v)))
|
||||
|
||||
(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
|
||||
resolved-module-path-name
|
||||
(module-path-index-resolve (syntax-source-module
|
||||
(namespace-syntax-introduce
|
||||
(namespace-syntax-introduce
|
||||
(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
|
||||
;; this line is necessary, but you can require anything
|
||||
;;(require (only-in racket/base))
|
||||
|
||||
|
||||
(define very-confused-x 10))
|
||||
|
||||
(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
|
||||
(require (for-syntax racket/base))
|
||||
(provide out)
|
||||
|
||||
|
||||
(define-syntax (m stx)
|
||||
(dynamic-require ''defines-a-variable-x-in-its-body #f)
|
||||
#`(quote #,(eval 'x (module->namespace ''defines-a-variable-x-in-its-body))))
|
||||
|
||||
|
||||
(define out (m)))
|
||||
|
||||
(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)])
|
||||
(eval '(module m racket
|
||||
|
||||
|
||||
(require syntax/parse/define)
|
||||
|
||||
|
||||
(define-simple-macro (f m:id)
|
||||
(begin
|
||||
(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 a2 'a2)
|
||||
(define a3 'a3))
|
||||
|
||||
|
||||
(require (prefix-in a: 'a))
|
||||
|
||||
(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))
|
||||
(provide (all-from-out 'check-shadowing-in-other-phase-c)
|
||||
(for-syntax (all-from-out 'check-shadowing-in-other-phase-d))))
|
||||
|
||||
|
||||
(module check-shadowing-in-other-phase-a racket/base
|
||||
(require 'check-shadowing-in-other-phase-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
|
||||
(require (for-syntax racket/base)
|
||||
(for-meta 2 racket/base))
|
||||
|
||||
|
||||
(define-syntax (ct-eval stx)
|
||||
(syntax-case stx ()
|
||||
[(_ e) #`'#,(eval #'e)]))
|
||||
|
||||
|
||||
(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)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; `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 ....)`
|
||||
;; submodule doesn't lose track of the base scope of the
|
||||
|
|
|
|||
|
|
@ -12,7 +12,6 @@
|
|||
"cert.rkt"
|
||||
"submodule.rkt"
|
||||
"generic-interfaces.rkt"
|
||||
"kw-syntax-local.rkt" ; shadows `local-expand` and variants
|
||||
"kw-syntax-binding.rkt" ; shadows `syntax-binding-set-extend`
|
||||
(for-syntax "stxcase-scheme.rkt"))
|
||||
|
||||
|
|
@ -30,7 +29,7 @@
|
|||
struct
|
||||
(all-from-except "hash.rkt" paired-fold)
|
||||
(all-from "list.rkt")
|
||||
(all-from-except "string.rkt"
|
||||
(all-from-except "string.rkt"
|
||||
-regexp-replace*)
|
||||
(rename -regexp-replace* regexp-replace*)
|
||||
identifier?
|
||||
|
|
@ -40,7 +39,6 @@
|
|||
(all-from "cert.rkt")
|
||||
(all-from "submodule.rkt")
|
||||
(all-from "generic-interfaces.rkt")
|
||||
(all-from "kw-syntax-local.rkt")
|
||||
(all-from "kw-syntax-binding.rkt")
|
||||
(for-syntax syntax-rules syntax-id-rules ... _)
|
||||
(rename -open-input-file open-input-file)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
(module kw-syntax-local "pre-base.rkt"
|
||||
(module kw-syntax-binding "pre-base.rkt"
|
||||
(require (prefix-in k: '#%kernel))
|
||||
|
||||
(provide syntax-binding-set-extend)
|
||||
|
|
|
|||
|
|
@ -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?)))
|
||||
|
|
@ -222,7 +222,6 @@
|
|||
#:phase [phase (expand-context-phase ctx)]
|
||||
#:intdefs intdefs
|
||||
#:stop-ids [stop-ids #f]
|
||||
#:extend-stops? [extend-stops? #t]
|
||||
#:to-parsed-ok? [to-parsed-ok? #f]
|
||||
#:track-to-be-defined? [track-to-be-defined? #f]
|
||||
#:keep-#%expression? [keep-#%expression? #t])
|
||||
|
|
@ -230,11 +229,7 @@
|
|||
(expand-context-context ctx))
|
||||
(and (list? context)
|
||||
(list? (expand-context-context ctx)))))
|
||||
(define all-stop-ids (if stop-ids
|
||||
(if extend-stops?
|
||||
(stop-ids->all-stop-ids stop-ids phase)
|
||||
stop-ids)
|
||||
null))
|
||||
(define all-stop-ids (and stop-ids (stop-ids->all-stop-ids stop-ids phase)))
|
||||
(define def-ctx-scopes (if (expand-context-def-ctx-scopes ctx)
|
||||
(unbox (expand-context-def-ctx-scopes ctx))
|
||||
null))
|
||||
|
|
@ -280,7 +275,7 @@
|
|||
[just-once? #f]
|
||||
[in-local-expand? #t]
|
||||
[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]
|
||||
[need-eventually-defined (let ([ht (expand-context-need-eventually-defined ctx)])
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -678,9 +678,7 @@
|
|||
(rebuild
|
||||
rebuild-s
|
||||
(list (m 'set!)
|
||||
(substitute-variable id t #:no-stops? (free-id-set-empty-or-just-module*?
|
||||
(expand-context-stops ctx)
|
||||
(expand-context-phase ctx)))
|
||||
(substitute-variable id t #:no-stops? (free-id-set-empty-or-just-module*? (expand-context-stops ctx)))
|
||||
exp-rhs)))]
|
||||
[(not binding)
|
||||
(raise-unbound-syntax-error #f "unbound identifier" s id null
|
||||
|
|
|
|||
|
|
@ -1,9 +1,7 @@
|
|||
#lang racket/base
|
||||
(require "../common/list-ish.rkt"
|
||||
"../syntax/binding.rkt"
|
||||
"../syntax/syntax.rkt"
|
||||
"../syntax/scope.rkt"
|
||||
"../namespace/core.rkt")
|
||||
"../syntax/binding.rkt")
|
||||
|
||||
(provide free-id-set
|
||||
empty-free-id-set
|
||||
|
|
@ -31,10 +29,8 @@
|
|||
null))])
|
||||
(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))
|
||||
(or (zero? c)
|
||||
(and (= 1 c)
|
||||
(let* ([p-core-stx (syntax-shift-phase-level core-stx phase)]
|
||||
[mod-star-stx (datum->syntax p-core-stx 'module*)])
|
||||
(free-identifier=? (car (hash-values fs)) mod-star-stx phase phase)))))
|
||||
;; If any identifier other than `module*` is present, then many
|
||||
;; identifiers are present
|
||||
(c . <= . 1))
|
||||
|
|
|
|||
|
|
@ -23,26 +23,22 @@
|
|||
local-transformer-expand/capture-lifts
|
||||
syntax-local-expand-expression)
|
||||
|
||||
(define (local-expand s context stop-ids [intdefs '()] [extend-stops? #t])
|
||||
(do-local-expand 'local-expand s context stop-ids intdefs
|
||||
#:extend-stops? extend-stops?))
|
||||
(define (local-expand s context stop-ids [intdefs '()])
|
||||
(do-local-expand 'local-expand s context stop-ids intdefs))
|
||||
|
||||
(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
|
||||
#:capture-lifts? #t
|
||||
#:extend-stops? extend-stops?
|
||||
#: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
|
||||
#:as-transformer? #t
|
||||
#:extend-stops? extend-stops?))
|
||||
#:as-transformer? #t))
|
||||
|
||||
(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
|
||||
#:as-transformer? #t
|
||||
#:capture-lifts? #t
|
||||
#:extend-stops? extend-stops?
|
||||
#:lift-key lift-key))
|
||||
|
||||
(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 '()]
|
||||
#:capture-lifts? [capture-lifts? #f]
|
||||
#:as-transformer? [as-transformer? #f]
|
||||
#:extend-stops? [extend-stops? #t]
|
||||
#:to-parsed-ok? [to-parsed-ok? #f]
|
||||
#:keep-#%expression? [keep-#%expression? #t]
|
||||
#:lift-key [lift-key (and (or capture-lifts?
|
||||
|
|
@ -109,7 +104,6 @@
|
|||
#:phase phase
|
||||
#:intdefs intdefs
|
||||
#:stop-ids stop-ids
|
||||
#:extend-stops? extend-stops?
|
||||
#:to-parsed-ok? to-parsed-ok?
|
||||
#:keep-#%expression? (or keep-#%expression?
|
||||
(and (expand-context-in-local-expand? ctx)
|
||||
|
|
|
|||
|
|
@ -340,9 +340,7 @@
|
|||
;; A reference to a variable expands to itself
|
||||
(register-variable-referenced-if-local! binding)
|
||||
;; 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*?
|
||||
(expand-context-stops ctx)
|
||||
(expand-context-phase ctx))))
|
||||
(define result-s (substitute-variable id t #:no-stops? (free-id-set-empty-or-just-module*? (expand-context-stops ctx))))
|
||||
(cond
|
||||
[(and (expand-context-to-parsed? ctx)
|
||||
(free-id-set-empty? (expand-context-stops ctx)))
|
||||
|
|
@ -409,8 +407,7 @@
|
|||
(log-expand ctx 'macro-pre-x cleaned-s)
|
||||
(define confine-def-ctx-scopes?
|
||||
(not (or (expand-context-only-immediate? ctx)
|
||||
(not (free-id-set-empty-or-just-module*? (expand-context-stops ctx)
|
||||
(expand-context-phase ctx))))))
|
||||
(not (free-id-set-empty-or-just-module*? (expand-context-stops ctx))))))
|
||||
(define accum-ctx
|
||||
(if (and confine-def-ctx-scopes?
|
||||
(expand-context-def-ctx-scopes ctx)
|
||||
|
|
|
|||
|
|
@ -296,7 +296,7 @@
|
|||
|
||||
;; Passes 1 and 2 are nested via `begin-for-syntax`:
|
||||
(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
|
||||
|
|
@ -305,6 +305,7 @@
|
|||
;; Need to accumulate definition contexts created during
|
||||
;; partial expansion:
|
||||
(define def-ctx-scopes (box null))
|
||||
(define to-parsed? (expand-context-to-parsed? ctx))
|
||||
|
||||
(define partial-body-ctx (struct*-copy expand-context ctx
|
||||
[context 'module]
|
||||
|
|
@ -355,9 +356,7 @@
|
|||
(log-expand partial-body-ctx 'next-group)
|
||||
|
||||
(define body-ctx (struct*-copy expand-context (accumulate-def-ctx-scopes partial-body-ctx def-ctx-scopes)
|
||||
[stops (if keep-stops?
|
||||
(expand-context-stops ctx)
|
||||
empty-free-id-set)]
|
||||
[stops empty-free-id-set]
|
||||
[def-ctx-scopes #f]
|
||||
[post-expansion #:parent root-expand-context #f]
|
||||
[to-module-lifts (make-to-module-lift-context phase
|
||||
|
|
@ -757,7 +756,7 @@
|
|||
(prepare-next-phase-namespace partial-body-ctx)
|
||||
(log-expand partial-body-ctx 'phase-up)
|
||||
(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)
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "7.0.0.19"
|
||||
#define MZSCHEME_VERSION "7.0.0.20"
|
||||
|
||||
#define MZSCHEME_VERSION_X 7
|
||||
#define MZSCHEME_VERSION_Y 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_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user