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

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

Browse Source 
Also, adjust the expansion of #%plain-module-begin to reinstate the stop
list after initial partial expansion.
This commit is contained in:
Alexis King 2018-06-12 10:01:02 -05:00
parent 88e5daf65c
commit 41fd4f3a5e
15 changed files with 8786 additions and 8310 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 version "7.0.0.1")
(define version "7.0.0.2")
(define deps `("racket-lib"
["racket" #:version ,version]))

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

@ -232,11 +232,12 @@ 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?) empty #f)]
[stop-ids (or/c (listof identifier?) (cons/c 'only (listof identifier?)) #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
@ -259,12 +260,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 @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 stops when the expander encounters any of
the forms in @racket[stop-ids], and the result is the partially-expanded form.
@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], @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].
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
@ -273,9 +275,13 @@ 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.
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].
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].
Expansion does not replace the scopes in a local-variable
reference to match the binding identifier.}
@ -358,7 +364,8 @@ 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].}]}
@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? #f])

8561
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,7 +482,8 @@
(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))
(except-out (all-from-out racket/base) #%module-begin)
(for-syntax (all-from-out racket/base)))
(define-syntax (mb stx)
(syntax-case stx ()
[(_ 10) #'(#%plain-module-begin 10)]
@ -491,17 +492,20 @@
(let ([e (local-expand #'(#%plain-module-begin form ...)
'module-begin
(list #'module*))])
(syntax-case e (module module* quote #%plain-app)
(syntax-case e (module module* quote #%plain-app begin-for-syntax)
[(mod-beg
(#%plain-app + (quote 1) (quote 2))
(module* q #f 10)
(module* z #f 11))
(module* z #f 11)
(begin-for-syntax (module* r #f 12)))
'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))
(module* q #f 10)
(module* z #f 11)
(begin-for-syntax (module* r #f 12)))
(module uses-internal-definition-context-around-id racket/base

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

@ -2690,6 +2690,37 @@ 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)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

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

@ -12,6 +12,7 @@
"cert.rkt"
"submodule.rkt"
"generic-interfaces.rkt"
"kw-syntax-local.rkt" ; shadows local-expand and variants
(for-syntax "stxcase-scheme.rkt"))
(#%provide (all-from-except "pre-base.rkt"
@ -38,6 +39,7 @@
(all-from "cert.rkt")
(all-from "submodule.rkt")
(all-from "generic-interfaces.rkt")
(all-from "kw-syntax-local.rkt")
(for-syntax syntax-rules syntax-id-rules ... _)
(rename -open-input-file open-input-file)
(rename -open-output-file open-output-file)

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

@ -0,0 +1,24 @@
(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,6 +222,7 @@
#: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])
@ -229,7 +230,11 @@
(expand-context-context ctx))
(and (list? context)
(list? (expand-context-context ctx)))))
(define all-stop-ids (and stop-ids (stop-ids->all-stop-ids stop-ids phase)))
(define all-stop-ids (if stop-ids
(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)
(unbox (expand-context-def-ctx-scopes ctx))
null))
@ -275,7 +280,7 @@
[just-once? #f]
[in-local-expand? #t]
[keep-#%expression? keep-#%expression?]
[stops (free-id-set phase (or all-stop-ids null))]
[stops (free-id-set phase all-stop-ids)]
[current-introduction-scopes null]
[need-eventually-defined (let ([ht (expand-context-need-eventually-defined ctx)])
(cond

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

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

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

@ -1,7 +1,9 @@
#lang racket/base
(require "../common/list-ish.rkt"
"../syntax/binding.rkt"
"../syntax/syntax.rkt"
"../syntax/binding.rkt")
"../syntax/scope.rkt"
"../namespace/core.rkt")
(provide free-id-set
empty-free-id-set
@ -29,8 +31,10 @@
null))])
(free-identifier=? id given-id phase phase))))
(define (free-id-set-empty-or-just-module*? fs)
(define (free-id-set-empty-or-just-module*? fs phase)
(define c (hash-count fs))
;; If any identifier other than `module*` is present, then many
;; identifiers are present
(c . <= . 1))
(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)))))

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

@ -22,22 +22,26 @@
local-transformer-expand/capture-lifts
syntax-local-expand-expression)
(define (local-expand s context stop-ids [intdefs '()])
(do-local-expand 'local-expand s context stop-ids intdefs))
(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/capture-lifts s context stop-ids [intdefs '()] [lift-key (generate-lift-key)])
(define (local-expand/capture-lifts s context stop-ids [intdefs '()] [lift-key (generate-lift-key)] [extend-stops? #t])
(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 '()])
(define (local-transformer-expand s context stop-ids [intdefs '()] [extend-stops? #t])
(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)])
(define (local-transformer-expand/capture-lifts s context stop-ids [intdefs '()] [lift-key (generate-lift-key)] [extend-stops? #t])
(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])
@ -67,6 +71,7 @@
(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?
@ -103,6 +108,7 @@
#: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)

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

@ -339,7 +339,9 @@
;; 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))))
(define result-s (substitute-variable id t #:no-stops? (free-id-set-empty-or-just-module*?
(expand-context-stops ctx)
(expand-context-phase ctx))))
(cond
[(and (expand-context-to-parsed? ctx)
(free-id-set-empty? (expand-context-stops ctx)))
@ -406,7 +408,8 @@
(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))))))
(not (free-id-set-empty-or-just-module*? (expand-context-stops ctx)
(expand-context-phase ctx))))))
(define accum-ctx
(if (and confine-def-ctx-scopes?
(expand-context-def-ctx-scopes ctx)

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

@ -300,7 +300,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])
(let pass-1-and-2-loop ([bodys bodys] [phase phase] [keep-stops? (stop-at-module*? ctx)])
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;; Pass 1: partially expand to discover all bindings and install all
@ -309,7 +309,6 @@
;; 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]
@ -360,7 +359,9 @@
(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 empty-free-id-set]
[stops (if keep-stops?
(expand-context-stops ctx)
empty-free-id-set)]
[def-ctx-scopes #f]
[post-expansion #:parent root-expand-context #f]
[to-module-lifts (make-to-module-lift-context phase
@ -760,7 +761,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)))
(define nested-bodys (pass-1-and-2-loop (m 'e) (add1 phase) #f))
(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)

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "7.0.0.1"
#define MZSCHEME_VERSION "7.0.0.2"
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 1
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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

File diff suppressed because it is too large Load Diff