expander: reject internal sequence that ends in define-syntaxes
For example, don't allow (let () 8 (define-syntax-rule (m) 9))
This commit is contained in:
parent
2cfc7ac8ae
commit
e4517afb56
|
@ -715,6 +715,7 @@
|
||||||
(test 5 'let* (let* ([x 4][x 5]) x))
|
(test 5 'let* (let* ([x 4][x 5]) x))
|
||||||
(error-test-let #'(() (define x 10)))
|
(error-test-let #'(() (define x 10)))
|
||||||
(error-test-let #'(() (define x 10) (define y 20)))
|
(error-test-let #'(() (define x 10) (define y 20)))
|
||||||
|
(error-test-let #'(() 8 (define-syntax-rule (m) 10)))
|
||||||
|
|
||||||
(define (do-error-test-let-values/no-* expr syntax-test)
|
(define (do-error-test-let-values/no-* expr syntax-test)
|
||||||
(syntax-test (datum->syntax #f (cons 'let-values expr) #f))
|
(syntax-test (datum->syntax #f (cons 'let-values expr) #f))
|
||||||
|
|
|
@ -78,7 +78,8 @@
|
||||||
[trans-idss null] ; accumulated `define-syntaxes` identifiers that have disappeared
|
[trans-idss null] ; accumulated `define-syntaxes` identifiers that have disappeared
|
||||||
[trans-stxs null] ; accumulated `define-syntaxes` forms for tracking
|
[trans-stxs null] ; accumulated `define-syntaxes` forms for tracking
|
||||||
[stx-clauses null] ; accumulated syntax-binding clauses, used when observing
|
[stx-clauses null] ; accumulated syntax-binding clauses, used when observing
|
||||||
[dups (make-check-no-duplicate-table)])
|
[dups (make-check-no-duplicate-table)]
|
||||||
|
[just-saw-define-syntaxes? #f]) ; make sure that `define-syntaxes` isn't last
|
||||||
(cond
|
(cond
|
||||||
[(null? bodys)
|
[(null? bodys)
|
||||||
;; Partial expansion is complete, so finish by rewriting to
|
;; Partial expansion is complete, so finish by rewriting to
|
||||||
|
@ -89,6 +90,7 @@
|
||||||
#:original-bodys init-bodys
|
#:original-bodys init-bodys
|
||||||
#:source s
|
#:source s
|
||||||
#:stratified? stratified?
|
#:stratified? stratified?
|
||||||
|
#:just-saw-define-syntaxes? just-saw-define-syntaxes?
|
||||||
#:name name
|
#:name name
|
||||||
#:disappeared-transformer-bindings (reverse trans-idss)
|
#:disappeared-transformer-bindings (reverse trans-idss)
|
||||||
#:disappeared-transformer-forms (reverse trans-stxs))]
|
#:disappeared-transformer-forms (reverse trans-stxs))]
|
||||||
|
@ -118,7 +120,8 @@
|
||||||
trans-idss
|
trans-idss
|
||||||
trans-stxs
|
trans-stxs
|
||||||
stx-clauses
|
stx-clauses
|
||||||
dups)]
|
dups
|
||||||
|
just-saw-define-syntaxes?)]
|
||||||
[(define-values)
|
[(define-values)
|
||||||
;; Found a variable definition; add bindings, extend the
|
;; Found a variable definition; add bindings, extend the
|
||||||
;; environment, and continue
|
;; environment, and continue
|
||||||
|
@ -166,7 +169,8 @@
|
||||||
trans-idss
|
trans-idss
|
||||||
trans-stxs
|
trans-stxs
|
||||||
stx-clauses
|
stx-clauses
|
||||||
new-dups)]
|
new-dups
|
||||||
|
#f)]
|
||||||
[(define-syntaxes)
|
[(define-syntaxes)
|
||||||
;; Found a macro definition; add bindings, evaluate the
|
;; Found a macro definition; add bindings, evaluate the
|
||||||
;; compile-time right-hand side, install the compile-time
|
;; compile-time right-hand side, install the compile-time
|
||||||
|
@ -204,7 +208,8 @@
|
||||||
(cons ids trans-idss)
|
(cons ids trans-idss)
|
||||||
(cons (keep-as-needed body-ctx exp-body #:for-track? #t) trans-stxs)
|
(cons (keep-as-needed body-ctx exp-body #:for-track? #t) trans-stxs)
|
||||||
(cons (datum->syntax #f (list ids (m 'rhs)) exp-body) stx-clauses)
|
(cons (datum->syntax #f (list ids (m 'rhs)) exp-body) stx-clauses)
|
||||||
new-dups)]
|
new-dups
|
||||||
|
#t)]
|
||||||
[else
|
[else
|
||||||
(cond
|
(cond
|
||||||
[stratified?
|
[stratified?
|
||||||
|
@ -223,7 +228,8 @@
|
||||||
trans-idss
|
trans-idss
|
||||||
trans-stxs
|
trans-stxs
|
||||||
stx-clauses
|
stx-clauses
|
||||||
dups)]
|
dups
|
||||||
|
#f)]
|
||||||
[else
|
[else
|
||||||
;; Found an expression; accumulate it and continue
|
;; Found an expression; accumulate it and continue
|
||||||
(loop body-ctx
|
(loop body-ctx
|
||||||
|
@ -236,7 +242,8 @@
|
||||||
trans-idss
|
trans-idss
|
||||||
trans-stxs
|
trans-stxs
|
||||||
stx-clauses
|
stx-clauses
|
||||||
dups)])])])))
|
dups
|
||||||
|
#f)])])])))
|
||||||
|
|
||||||
;; Partial expansion is complete, so assumble the result as a
|
;; Partial expansion is complete, so assumble the result as a
|
||||||
;; `letrec-values` form and continue expanding
|
;; `letrec-values` form and continue expanding
|
||||||
|
@ -246,10 +253,12 @@
|
||||||
#:original-bodys init-bodys
|
#:original-bodys init-bodys
|
||||||
#:source s
|
#:source s
|
||||||
#:stratified? stratified?
|
#:stratified? stratified?
|
||||||
|
#:just-saw-define-syntaxes? just-saw-define-syntaxes?
|
||||||
#:name name
|
#:name name
|
||||||
#:disappeared-transformer-bindings disappeared-transformer-bindings
|
#:disappeared-transformer-bindings disappeared-transformer-bindings
|
||||||
#:disappeared-transformer-forms disappeared-transformer-forms)
|
#:disappeared-transformer-forms disappeared-transformer-forms)
|
||||||
(when (null? done-bodys)
|
(when (or (null? done-bodys)
|
||||||
|
just-saw-define-syntaxes?)
|
||||||
(raise-syntax-error (string->symbol "begin (possibly implicit)")
|
(raise-syntax-error (string->symbol "begin (possibly implicit)")
|
||||||
"no expression after a sequence of internal definitions"
|
"no expression after a sequence of internal definitions"
|
||||||
(datum->syntax #f (cons 'begin init-bodys) s)
|
(datum->syntax #f (cons 'begin init-bodys) s)
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user