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:
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"))
|
||||
|
||||
|
@ -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