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 2018-09-12 14:30:34 -05:00
parent 5be4109495
commit 6b56156d55
17 changed files with 4888 additions and 5341 deletions

View File

@ -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]))

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

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

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))
(provide syntax-binding-set-extend)

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?)))

View File

@ -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

View File

@ -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

View File

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

View File

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

View File

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

View File

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

View File

@ -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