diff --git a/pkgs/deinprogramm/signature/module-begin.rkt b/pkgs/deinprogramm/signature/module-begin.rkt index ddcba39e81..6727a123c0 100644 --- a/pkgs/deinprogramm/signature/module-begin.rkt +++ b/pkgs/deinprogramm/signature/module-begin.rkt @@ -70,8 +70,7 @@ (values table non-signatures)))) (define local-expand-stop-list - (append (list #': #'define-contract - #'#%require #'#%provide) + (append (list #': #'define-contract) (kernel-form-identifier-list))) (define (expand-signature-expressions signature-table expressions) @@ -173,7 +172,7 @@ (let ((e2 (local-expand #'e2 'module local-expand-stop-list))) ;; Lift out certain forms to make them visible to the module ;; expander: - (syntax-case e2 (#%require #%provide + (syntax-case e2 (#%require #%provide #%declare define-syntaxes begin-for-syntax define-values begin define-record-procedures define-record-procedures-2 define-record-procedures-parametric define-record-procedures-parametric-2 @@ -182,6 +181,8 @@ #`(begin #,e2 (frm e3s #,e1s #,def-ids))) ((#%provide . __) #`(begin #,e2 (frm e3s #,e1s #,def-ids))) + ((#%declare . __) + #`(begin #,e2 (frm e3s #,e1s #,def-ids))) ((define-syntaxes (id ...) . _) #`(begin #,e2 (frm e3s #,e1s (id ... . #,def-ids)))) ((begin-for-syntax . _) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/contract-traversal.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/contract-traversal.rkt index b043c008ef..e0cd2176b2 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/contract-traversal.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/contract-traversal.rkt @@ -103,6 +103,8 @@ (ploop #'last-one polarity)] [(#%provide pvd ...) (call-give-up)] + [(#%declare decl ...) + (call-give-up)] [(define-values (id ...) expr) (call-give-up)] [(define-syntaxes (id ...) expr) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/traversals.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/traversals.rkt index a95adb1e11..d55915b37c 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/traversals.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/syncheck/traversals.rkt @@ -210,7 +210,7 @@ #%plain-app #%top #%plain-module-begin define-values define-syntaxes begin-for-syntax module module* - #%require #%provide #%expression) + #%require #%provide #%declare #%expression) (λ (x y) (free-identifier=? x y level 0)) [(#%plain-lambda args bodies ...) (begin @@ -401,6 +401,10 @@ (for ([provided-vars (in-list provided-varss)]) (for ([provided-var (in-list provided-vars)]) (add-id varrefs provided-var level-of-enclosing-module))))] + + ; module top level only: + [(#%declare declare-specs ...) + (void)] [(#%expression arg) (begin diff --git a/pkgs/drracket-pkgs/drracket/gui-debugger/annotator.rkt b/pkgs/drracket-pkgs/drracket/gui-debugger/annotator.rkt index 5a06aca296..a567b80619 100644 --- a/pkgs/drracket-pkgs/drracket/gui-debugger/annotator.rkt +++ b/pkgs/drracket-pkgs/drracket/gui-debugger/annotator.rkt @@ -184,6 +184,8 @@ stx #f [(#%provide . provide-specs) stx] + [(#%declare . declare-specs) + stx] [else-stx (general-top-level-expr-iterator stx module-name )])) diff --git a/pkgs/errortrace-pkgs/errortrace-lib/errortrace/errortrace-key.rkt b/pkgs/errortrace-pkgs/errortrace-lib/errortrace/errortrace-key.rkt index 391d5bda17..4a41720436 100644 --- a/pkgs/errortrace-pkgs/errortrace-lib/errortrace/errortrace-key.rkt +++ b/pkgs/errortrace-pkgs/errortrace-lib/errortrace/errortrace-key.rkt @@ -1,5 +1,7 @@ (module errortrace-key '#%kernel + (#%declare #:cross-phase-persistent) + ;; this file is badly named; it contains ;; all of the code used at runtime by the ;; various annotations inserted by this diff --git a/pkgs/errortrace-pkgs/errortrace-lib/errortrace/stacktrace.rkt b/pkgs/errortrace-pkgs/errortrace-lib/errortrace/stacktrace.rkt index 0e057cfb96..34d7e13d0c 100644 --- a/pkgs/errortrace-pkgs/errortrace-lib/errortrace/stacktrace.rkt +++ b/pkgs/errortrace-pkgs/errortrace-lib/errortrace/stacktrace.rkt @@ -416,7 +416,7 @@ [(#%require i ...) expr] ;; No error possible (and no way to wrap) [(#%provide i ...) expr] - + [(#%declare i ...) expr] ;; No error possible [(quote _) diff --git a/pkgs/frtime/opt/frtime-opt.rkt b/pkgs/frtime/opt/frtime-opt.rkt index a805c49cee..6f0364f14b 100644 --- a/pkgs/frtime/opt/frtime-opt.rkt +++ b/pkgs/frtime/opt/frtime-opt.rkt @@ -136,10 +136,10 @@ [(_ EQUIV-MAP FORM FORMS ...) (let ([expanded-form (local-expand #'FORM 'module - (list #'begin #'begin0 #'#%provide #'#%require + (list #'begin #'begin0 #'#%provide #'#%require #'#%declare #'define-syntaxes #'define-values-for-syntax #'define-values #'#%app #'unit #'unit/sig))]) - (syntax-case expanded-form (begin begin0 #%provide #%require + (syntax-case expanded-form (begin begin0 #%provide #%require #%declare define-syntaxes define-values-for-syntax define-values #%app) ;; explode top-level begin statements @@ -156,7 +156,12 @@ ;; TBD: support frtime-specific provide specs (lifted, etc) #`(begin #,expanded-form (optimize-module EQUIV-MAP FORMS ...))] - + + ;; declare + [(#%declare . __) + #`(begin #,expanded-form + (optimize-module EQUIV-MAP FORMS ...))] + ;; syntax definitions [(define-syntaxes . __) #`(begin #,expanded-form diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/private/teach-module-begin.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/private/teach-module-begin.rkt index 22addf011d..f126b11ce0 100644 --- a/pkgs/htdp-pkgs/htdp-lib/lang/private/teach-module-begin.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/lang/private/teach-module-begin.rkt @@ -76,8 +76,7 @@ (values table non-signatures)))) (define local-expand-stop-list - (append (list #': #'define-signature - #'#%require #'#%provide) + (append (list #': #'define-signature) (kernel-form-identifier-list))) (define (expand-signature-expressions signature-table expressions) @@ -179,13 +178,15 @@ (let ((e2 (local-expand #'e2 'module local-expand-stop-list))) ;; Lift out certain forms to make them visible to the module ;; expander: - (syntax-case e2 (#%require #%provide + (syntax-case e2 (#%require #%provide #%declare define-syntaxes begin-for-syntax define-values begin define-signature :) ((#%require . __) #`(begin #,e2 (frm e3s #,e1s #,def-ids))) ((#%provide . __) #`(begin #,e2 (frm e3s #,e1s #,def-ids))) + ((#%declare . __) + #`(begin #,e2 (frm e3s #,e1s #,def-ids))) ((define-syntaxes (id ...) . _) #`(begin #,e2 (frm e3s #,e1s (id ... . #,def-ids)))) ((begin-for-syntax . _) diff --git a/pkgs/htdp-pkgs/htdp-lib/stepper/private/annotate.rkt b/pkgs/htdp-pkgs/htdp-lib/stepper/private/annotate.rkt index d5ac6023ab..07075bb7ba 100644 --- a/pkgs/htdp-pkgs/htdp-lib/stepper/private/annotate.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/stepper/private/annotate.rkt @@ -1043,7 +1043,7 @@ (skipto/auto exp 'rebuild annotate/module-top-level)] [else (syntax-case exp (#%app #%plain-app call-with-values define-values define-syntaxes - #%require #%provide begin #%plain-lambda lambda + #%require #%provide #%declare begin #%plain-lambda lambda module module*) [(define-values (new-var ...) e) (let* ([name-list (syntax->list #`(new-var ...))] @@ -1074,6 +1074,8 @@ exp] [(#%provide specs ...) exp] + [(#%declare specs ...) + exp] [(module . _) ; submodule exp] [(module* . _) ; submodule diff --git a/pkgs/htdp-pkgs/htdp-lib/stepper/private/lifting.rkt b/pkgs/htdp-pkgs/htdp-lib/stepper/private/lifting.rkt index 1d05d85a51..138d8f8c38 100644 --- a/pkgs/htdp-pkgs/htdp-lib/stepper/private/lifting.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/stepper/private/lifting.rkt @@ -75,6 +75,8 @@ stx #f [(#%provide . provide-specs) (void)] + [(#%declare . declare-specs) + (void)] [else-stx (general-top-level-expr-iterator stx context-so-far)])) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/eval-model.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/eval-model.scrbl index 194e22e753..31c9463e5c 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/eval-model.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/eval-model.scrbl @@ -601,10 +601,12 @@ top-levels are in corresponding higher @tech{phase}s. @;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @subsection[#:tag "cross-phase persistent-modules"]{Cross-Phase Persistent Modules} -Module declarations that fit a highly constrained form create -@deftech{cross-phase persistent} modules. A @tech{cross-phase persistent} module's -instantiations across all phases and @tech{module registries} share -the variables produced by the first instantiation of the module. +Module declarations that fit a highly constrained form---including a +@racket[(#%declare #:cross-phase-persistent)] form in the module +body---create @deftech{cross-phase persistent} modules. A +@tech{cross-phase persistent} module's instantiations across all +phases and @tech{module registries} share the variables produced by +the first instantiation of the module. The intent of a @tech{cross-phase persistent} module is to support values that are recognizable after @tech{phase} crossings. For example, when a macro diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax-model.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax-model.scrbl index 18fc72bc76..916fc102ef 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax-model.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax-model.scrbl @@ -187,7 +187,7 @@ the binding (according to @racket[free-identifier=?]) matters.} @racketgrammar*[ #:literals (#%expression module module* #%plain-module-begin begin #%provide define-values define-syntaxes begin-for-syntax - #%require + #%require #%declare #%plain-lambda case-lambda if begin begin0 let-values letrec-values set! quote-syntax quote with-continuation-mark #%plain-app #%top #%variable-reference) @@ -201,7 +201,8 @@ the binding (according to @racket[free-identifier=?]) matters.} [module-level-form general-top-level-form (#%provide raw-provide-spec ...) (begin-for-syntax module-level-form ...) - submodule-form] + submodule-form + (#%declare declaration-keyword ...)] [submodule-form (module id module-path (#%plain-module-begin module-level-form ...)) @@ -993,12 +994,13 @@ to syntax transformers, via @racket[syntax-local-name]. A module is @tech{cross-phase persistent} only if it fits the following grammar, which uses non-terminals from @secref["fully-expanded"], only if +it includes @racket[(#%declare #:cross-phase-persistent)], only it includes no uses of @racket[quote-syntax] or @racket[#%variable-reference], and only if no module-level binding is @racket[set!]ed. @racketgrammar*[ #:literals (module module* #%plain-module-begin begin #%provide - define-values #%require + define-values #%require #%declare #%plain-lambda case-lambda begin set! quote-syntax quote with-continuation-mark #%plain-app @@ -1006,7 +1008,8 @@ and only if no module-level binding is @racket[set!]ed. [cross-module (module id module-path (#%plain-module-begin cross-form ...))] -[cross-form (begin cross-form ...) +[cross-form (#%declare #:cross-phase-persistent) + (begin cross-form ...) (#%provide raw-provide-spec ...) submodule-form (define-values (id ...) cross-expr) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl index d175c1d430..2f3b785d5d 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl @@ -367,6 +367,29 @@ Like @racket[#%module-begin], but without adding a Legal only in a @tech{module begin context}, and handled by the @racket[module] and @racket[module*] forms.} +@defform[(#%declare declaration-keyword ...) + #:grammar + ([declaration-keyword #:cross-phase-persistent])]{ + +Declarations that affect run-time or reflective properties of the +module: + +@itemlist[ + + @item{@indexed-racket[#:cross-phase-persistent] --- declares the + module as @tech{cross-phase persistent}, and reports a syntax + error if the module does not meet the import or syntactic + constraints of a @tech{cross-phase persistent} module.} + +] + +A @racket[#%declare] form must appear in a @tech{module +context} or a @tech{module-begin context}. Each +@racket[declaration-keyword] can be declared at most once within a +@racket[module] body. + +} + @;------------------------------------------------------------------------ @section[#:tag '("require" "provide")]{Importing and Exporting: @racket[require] and @racket[provide]} diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/cross-phase.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/cross-phase.rkt index 4a4da9733d..aff76a53c9 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/cross-phase.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/racket/cross-phase.rkt @@ -3,12 +3,16 @@ (define (check-cross-phase is? form) (parameterize ([current-namespace (make-base-namespace)]) (define o (open-output-bytes)) - (write (compile `(module m racket/kernel ,form)) o) + (define syntax-error? + (with-handlers ([exn:fail:syntax? (lambda (exn) #t)]) + (write (compile `(module m racket/kernel (#%declare #:cross-phase-persistent) ,form)) o) + #f)) (close-output-port o) (define i (open-input-bytes (get-output-bytes o))) (define e (parameterize ([read-accept-compiled #t]) (read i))) - (unless (equal? is? (module-compiled-cross-phase-persistent? e)) + (unless (equal? is? (and (not syntax-error?) + (module-compiled-cross-phase-persistent? e))) (error 'cross-phase "failed: ~s ~s" is? form)))) (check-cross-phase #t '(define-values (x) 5)) @@ -53,6 +57,7 @@ (parameterize ([current-namespace (make-base-namespace)]) (eval `(module m racket/kernel (#%provide s? make-s) + (#%declare #:cross-phase-persistent) (define-values (struct:s make-s s? s-ref s-set!) (make-struct-type 's #f 0 0)))) (eval '(require 'm)) (define s? (eval 's?)) @@ -80,6 +85,7 @@ (parameterize ([compile-enforce-module-constants #f]) (eval `(module m racket/kernel (#%provide x) + (#%declare #:cross-phase-persistent) (define-values (x) 5))) (compile `(module m racket/kernel (#%provide x) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/doclang.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/doclang.rkt index 718d666a84..f3d781dc88 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/doclang.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/doclang.rkt @@ -40,9 +40,7 @@ #'body1 'module (append (kernel-form-identifier-list) (syntax->list #'(provide - require - #%provide - #%require))))]) + require))))]) (syntax-case expanded (begin) [(begin body1 ...) #`(doc-begin m-id post-process exprs body1 ... . body)] @@ -57,7 +55,8 @@ module module* #%require - #%provide)))) + #%provide + #%declare)))) #`(begin #,expanded (doc-begin m-id post-process exprs . body))] [_else #`(doc-begin m-id post-process diff --git a/pkgs/scribble-pkgs/scribble-text-lib/scribble/text/syntax-utils.rkt b/pkgs/scribble-pkgs/scribble-text-lib/scribble/text/syntax-utils.rkt index 3240a1d336..da3a41777c 100644 --- a/pkgs/scribble-pkgs/scribble-text-lib/scribble/text/syntax-utils.rkt +++ b/pkgs/scribble-pkgs/scribble-text-lib/scribble/text/syntax-utils.rkt @@ -8,7 +8,7 @@ (begin-for-syntax (define definition-ids ; ids that don't require forcing (syntax->list #'(define-values define-syntaxes begin-for-syntax - require provide #%require #%provide))) + require provide #%require #%provide #%declare))) (define stoplist (append definition-ids (kernel-form-identifier-list))) (define (definition-id? id) (and (identifier? id) diff --git a/pkgs/trace/stacktrace.rkt b/pkgs/trace/stacktrace.rkt index 0acf14d95b..2cf2a0c7d8 100644 --- a/pkgs/trace/stacktrace.rkt +++ b/pkgs/trace/stacktrace.rkt @@ -35,6 +35,8 @@ (kernel-syntax-case stx #f [(#%provide . provide-specs) stx] + [(#%declare . provide-specs) + stx] [else-stx (general-top-level-expr-iterator stx)])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt index 13c9dd0670..ab78b66889 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt @@ -16,8 +16,8 @@ (provide tc-setup invis-kw maybe-optimize init-current-type-names) (define-syntax-class invis-kw - #:literals (define-values define-syntaxes #%require #%provide begin) - (pattern (~or define-values define-syntaxes #%require #%provide begin))) + #:literals (define-values define-syntaxes #%require #%provide #%declare begin) + (pattern (~or define-values define-syntaxes #%require #%provide #%declare begin))) (define (maybe-optimize body) ;; do we optimize? diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt index 87beb73cc9..a89bec620f 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt @@ -214,6 +214,7 @@ ;; these forms should always be ignored [(#%require . _) (void)] [(#%provide . _) (void)] + [(#%declare . _) (void)] [(define-syntaxes . _) (void)] [(begin-for-syntax . _) (void)] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/arm.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/arm.rkt index ac38f7bf71..0aede1d6af 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/arm.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/arm.rkt @@ -6,7 +6,7 @@ ;; For simplicity, protect everything produced by Typed Racket. (define (arm stx) (syntax-case stx (module module* #%plain-module-begin - #%require #%provide begin + #%require #%provide #%declare begin define-values define-syntaxes begin-for-syntax) [(module name initial-import mb) @@ -18,6 +18,7 @@ 'opaque)] [(#%require . _) stx] [(#%provide . _) stx] + [(#%declare . _) stx] [(begin form ...) (quasisyntax/loc stx (begin #,@(stx-map arm #'(form ...))))] [(begin-for-syntax form ...) diff --git a/pkgs/web-server-pkgs/web-server-lib/web-server/lang/util.rkt b/pkgs/web-server-pkgs/web-server-lib/web-server/lang/util.rkt index 2a6ca6cad5..de3a2c2d0a 100644 --- a/pkgs/web-server-pkgs/web-server-lib/web-server/lang/util.rkt +++ b/pkgs/web-server-pkgs/web-server-lib/web-server/lang/util.rkt @@ -59,8 +59,9 @@ (inner #'expr)])) (define ((make-module-case inner) stx) - (syntax-case* stx (#%provide begin-for-syntax module module*) free-identifier=? + (syntax-case* stx (#%provide #%declare begin-for-syntax module module*) free-identifier=? [(#%provide . p) stx] + [(#%declare . d) stx] [(module* . m) stx] [(module . m) stx] [(begin-for-syntax . e) stx] diff --git a/racket/collects/racket/HISTORY.txt b/racket/collects/racket/HISTORY.txt index 7c1b9421a2..6820fbc0de 100644 --- a/racket/collects/racket/HISTORY.txt +++ b/racket/collects/racket/HISTORY.txt @@ -1,3 +1,8 @@ +Version 5.90.0.2 +Added #%declare +Cross-phase persistent modules must be declared with + (#%declare #:cross-phase-persistent) + Version 5.90.0.1 Added "share" directory, moved "pkgs" there; moved "collects" back out of "lib" diff --git a/racket/collects/racket/kernel.rkt b/racket/collects/racket/kernel.rkt index 1fdd4f2d6c..e446af0d11 100644 --- a/racket/collects/racket/kernel.rkt +++ b/racket/collects/racket/kernel.rkt @@ -1,5 +1,7 @@ (module kernel '#%kernel (#%provide (all-from '#%kernel)) + (#%declare #:cross-phase-persistent) + (module reader syntax/module-reader #:language 'racket/kernel)) diff --git a/racket/collects/racket/private/modbeg.rkt b/racket/collects/racket/private/modbeg.rkt index 5b10e2696c..1213c656ba 100644 --- a/racket/collects/racket/private/modbeg.rkt +++ b/racket/collects/racket/private/modbeg.rkt @@ -64,7 +64,7 @@ define-values define-syntaxes begin-for-syntax module module* #%module-begin - #%require #%provide + #%require #%provide #%declare #%variable-reference))))]) ;; `begin' is special... (if (let-values ([(p) (syntax-e e)]) @@ -101,7 +101,7 @@ (define-values define-syntaxes begin-for-syntax module module* #%module-begin - #%require #%provide)))) + #%require #%provide #%declare)))) #f ;; Also check for calls to `void': (if (free-identifier=? a (quote-syntax #%app)) diff --git a/racket/collects/racket/splicing.rkt b/racket/collects/racket/splicing.rkt index 0c54a97bdc..fcf2f0b3ca 100644 --- a/racket/collects/racket/splicing.rkt +++ b/racket/collects/racket/splicing.rkt @@ -198,7 +198,8 @@ module module* #%require - #%provide ) + #%provide + #%declare ) [(begin expr ...) (syntax/loc body (begin (expand-ssp-body (sp-id ...) (temp-id ...) (orig-id ...) expr) ...))] @@ -217,6 +218,7 @@ [(module* . _) body] [(#%require . _) body] [(#%provide . _) body] + [(#%declare . _) body] [expr (syntax/loc body (letrec-syntaxes ([(sp-id) (syntax-local-value (quote-syntax temp-id))] ...) expr))]))]))])) @@ -270,7 +272,7 @@ define-syntaxes define-values begin-for-syntax module module* - #%require #%provide + #%require #%provide #%declare quote-syntax) [(begin form ...) (syntax/loc e @@ -284,5 +286,6 @@ [(module* . _) e] [(#%require . _) e] [(#%provide . _) e] + [(#%declare . _) e] [(quote-syntax . _) e] [else (as-expression)]))))]))) diff --git a/racket/collects/racket/tcp.rkt b/racket/collects/racket/tcp.rkt index 40dce24ce2..92d18f3216 100644 --- a/racket/collects/racket/tcp.rkt +++ b/racket/collects/racket/tcp.rkt @@ -24,5 +24,8 @@ (c:tcp-addresses socket port-numbers?) (if (tcp-listener? socket) (c:tcp-addresses socket port-numbers?) - (raise-argument-error 'tcp-addresses "(or/c tcp-port? tcp-listener?)" socket)))]))) + (raise-argument-error 'tcp-addresses "(or/c tcp-port? tcp-listener?)" socket)))])) + + ;; Because we can, and because it makes a good test: + (#%declare #:cross-phase-persistent)) diff --git a/racket/collects/syntax/kerncase.rkt b/racket/collects/syntax/kerncase.rkt index 3d5b64c4dd..0901874784 100644 --- a/racket/collects/syntax/kerncase.rkt +++ b/racket/collects/syntax/kerncase.rkt @@ -24,7 +24,7 @@ define-values define-syntaxes begin-for-syntax module module* #%plain-module-begin - #%require #%provide + #%require #%provide #%declare #%variable-reference))))) (let ([p phase]) (cond @@ -85,7 +85,7 @@ #%top #%datum #%variable-reference - module module* #%provide #%require)))) + module module* #%provide #%require #%declare)))) (provide kernel-syntax-case kernel-syntax-case* diff --git a/racket/collects/syntax/parse/private/litconv.rkt b/racket/collects/syntax/parse/private/litconv.rkt index 69edc6634d..4f5e4be7e3 100644 --- a/racket/collects/syntax/parse/private/litconv.rkt +++ b/racket/collects/syntax/parse/private/litconv.rkt @@ -275,5 +275,5 @@ cause an error, so don't worry about that case.) #%top #%datum #%variable-reference - module #%provide #%require + module #%provide #%require #%declare #%plain-module-begin)) diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index 42ed744a01..787f85d5c9 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -90,6 +90,8 @@ static Scheme_Object *modulestar_syntax(Scheme_Object *form, Scheme_Comp_Env *en static Scheme_Object *modulestar_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec); static Scheme_Object *module_begin_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec); static Scheme_Object *module_begin_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec); +static Scheme_Object *declare_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec); +static Scheme_Object *declare_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec); static Scheme_Object *require_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec); static Scheme_Object *require_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec); static Scheme_Object *provide_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec); @@ -209,6 +211,7 @@ ROSYM static Scheme_Object *file_symbol; ROSYM static Scheme_Object *submod_symbol; ROSYM static Scheme_Object *module_name_symbol; ROSYM static Scheme_Object *nominal_id_symbol; +ROSYM static Scheme_Object *phaseless_keyword; /* global read-only syntax */ READ_ONLY Scheme_Object *scheme_module_stx; @@ -222,6 +225,7 @@ READ_ONLY Scheme_Object *scheme_begin_for_syntax_stx; READ_ONLY static Scheme_Object *modbeg_syntax; READ_ONLY static Scheme_Object *require_stx; READ_ONLY static Scheme_Object *provide_stx; +READ_ONLY static Scheme_Object *declare_stx; READ_ONLY static Scheme_Object *set_stx; READ_ONLY static Scheme_Object *app_stx; READ_ONLY static Scheme_Object *lambda_stx; @@ -283,6 +287,10 @@ THREAD_LOCAL_DECL(static Scheme_Object *global_shift_cache); #define MODULE_MODFORM_KIND 4 #define SAVED_MODFORM_KIND 5 +/* combined bitwise: */ +#define NON_PHASELESS_IMPORT 0x1 +#define NON_PHASELESS_FORM 0x2 + typedef void (*Check_Func)(Scheme_Object *prnt_name, Scheme_Object *name, Scheme_Object *nominal_modname, Scheme_Object *nominal_export, Scheme_Object *modname, Scheme_Object *srcname, int exet, @@ -302,7 +310,7 @@ static void parse_requires(Scheme_Object *form, int at_phase, int *all_simple, Scheme_Hash_Table *modix_cache, Scheme_Hash_Table *submodule_names, - int *maybe_phaseless); + int *non_phaseless); static void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e, int at_phase, Scheme_Hash_Table *all_provided, @@ -371,6 +379,11 @@ void scheme_init_module(Scheme_Env *env) modbeg_syntax, env); + scheme_add_global_keyword("#%declare", + scheme_make_compiled_syntax(declare_syntax, + declare_expand), + env); + scheme_add_global_keyword("#%require", scheme_make_compiled_syntax(require_syntax, require_expand), @@ -625,6 +638,7 @@ void scheme_finish_kernel(Scheme_Env *env) REGISTER_SO(scheme_begin_for_syntax_stx); REGISTER_SO(require_stx); REGISTER_SO(provide_stx); + REGISTER_SO(declare_stx); REGISTER_SO(set_stx); REGISTER_SO(app_stx); REGISTER_SO(scheme_top_stx); @@ -652,6 +666,7 @@ void scheme_finish_kernel(Scheme_Env *env) scheme_begin_for_syntax_stx = scheme_datum_to_syntax(scheme_intern_symbol("begin-for-syntax"), scheme_false, w, 0, 0); require_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%require"), scheme_false, w, 0, 0); provide_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%provide"), scheme_false, w, 0, 0); + declare_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%declare"), scheme_false, w, 0, 0); set_stx = scheme_datum_to_syntax(scheme_intern_symbol("set!"), scheme_false, w, 0, 0); app_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%app"), scheme_false, w, 0, 0); scheme_top_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%top"), scheme_false, w, 0, 0); @@ -722,6 +737,12 @@ void scheme_finish_kernel(Scheme_Env *env) REGISTER_SO(nominal_id_symbol); nominal_id_symbol = scheme_intern_symbol("nominal-id"); + + REGISTER_SO(phaseless_keyword); + { + const char *s = "cross-phase-persistent"; + phaseless_keyword = scheme_intern_exact_keyword(s, strlen(s)); + } } int scheme_is_kernel_modname(Scheme_Object *modname) @@ -8397,7 +8418,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ Scheme_Object *lift_data; Scheme_Object *lift_ctx; Scheme_Object *lifted_reqs = scheme_null, *req_data, *unbounds = scheme_null; - int maybe_has_lifts = 0, expand_ends = (phase == 0), maybe_phaseless; + int maybe_has_lifts = 0, expand_ends = (phase == 0), non_phaseless, requested_phaseless; Scheme_Object *observer, *vec, *end_statements; Scheme_Object *begin_for_syntax_stx; const char *who = "module"; @@ -8453,7 +8474,8 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ if (*bxs->_num_phases < phase + 1) *bxs->_num_phases = phase + 1; - maybe_phaseless = (env->genv->module->phaseless ? 1 : 0); + non_phaseless = (env->genv->module->phaseless ? 0 : NON_PHASELESS_IMPORT); + requested_phaseless = 0; env->genv->module->phaseless = NULL; /* Expand each expression in form up to `begin', `define-values', `define-syntax', @@ -8705,8 +8727,8 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ var_count++; } - if (maybe_phaseless && !phaseless_rhs(val, var_count, phase)) - maybe_phaseless = 0; + if (!(non_phaseless & NON_PHASELESS_FORM) && !phaseless_rhs(val, var_count, phase)) + non_phaseless |= NON_PHASELESS_FORM; SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer, e); kind = DEFN_MODFORM_KIND; @@ -8918,7 +8940,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ kind = DONE_MODFORM_KIND; - maybe_phaseless = 0; + non_phaseless |= NON_PHASELESS_FORM; } else if (scheme_stx_module_eq_x(require_stx, fst, phase)) { /************ require *************/ SCHEME_EXPAND_OBSERVE_ENTER_PRIM(observer, e); @@ -8933,7 +8955,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ 1, phase ? 1 : 0, bxs->all_simple_renames, bxs->modidx_cache, bxs->submodule_names, - &maybe_phaseless); + &non_phaseless); if (!erec) e = NULL; @@ -8947,6 +8969,28 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ bxs->saved_provides); bxs->saved_provides = p; kind = PROVIDE_MODFORM_KIND; + } else if (scheme_stx_module_eq_x(declare_stx, fst, phase)) { + /************ declare *************/ + Scheme_Object *kws, *kw; + + kws = SCHEME_STX_CDR(e); + while (SCHEME_STX_PAIRP(kws)) { + kw = SCHEME_STX_CAR(kws); + if (SCHEME_KEYWORDP(SCHEME_STX_VAL(kw))) { + if (SAME_OBJ(SCHEME_STX_VAL(kw), phaseless_keyword)) { + if (requested_phaseless) + scheme_wrong_syntax(who, kw, e, "duplicate declaration"); + requested_phaseless = 1; + } else { + scheme_wrong_syntax(who, kw, e, "unrecognized keyword"); + } + } + kws = SCHEME_STX_CDR(kws); + } + if (!SCHEME_STX_NULLP(kws)) + scheme_wrong_syntax(who, NULL, e, IMPROPER_LIST_FORM); + + kind = SAVED_MODFORM_KIND; } else if (scheme_stx_module_eq_x(scheme_module_stx, fst, phase) || scheme_stx_module_eq_x(scheme_modulestar_stx, fst, phase)) { /************ module[*] *************/ @@ -9008,14 +9052,14 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer,e); } else { kind = EXPR_MODFORM_KIND; - maybe_phaseless = 0; + non_phaseless |= NON_PHASELESS_FORM; } } else { - maybe_phaseless = 0; + non_phaseless |= NON_PHASELESS_FORM; kind = EXPR_MODFORM_KIND; } } else { - maybe_phaseless = 0; + non_phaseless |= NON_PHASELESS_FORM; kind = EXPR_MODFORM_KIND; } @@ -9283,7 +9327,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ bxs->all_defs = adt; if (cenv->prefix->non_phaseless) - maybe_phaseless = 0; + non_phaseless |= NON_PHASELESS_IMPORT; if (!phase) env->genv->module->comp_prefix = cenv->prefix; @@ -9303,8 +9347,16 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_ } } - if (maybe_phaseless) - env->genv->module->phaseless = scheme_true; + if (requested_phaseless) { + if (!non_phaseless) + env->genv->module->phaseless = scheme_true; + else { + if (non_phaseless & NON_PHASELESS_IMPORT) + scheme_wrong_syntax(who, form, NULL, "cannot be cross-phase persistent due to required modules"); + else + scheme_wrong_syntax(who, form, NULL, "does not satisfy cross-phase persistent grammar"); + } + } if (rec[drec].comp) { body_lists = scheme_make_pair(first, scheme_make_pair(exp_body, body_lists)); @@ -9552,7 +9604,7 @@ static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **_beg stop = scheme_get_stop_expander(); - scheme_add_local_syntax(21, xenv); + scheme_add_local_syntax(22, xenv); if (phase == 0) { scheme_set_local_syntax(0, scheme_begin_stx, stop, xenv); @@ -9577,6 +9629,7 @@ static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **_beg scheme_set_local_syntax(18, expression_stx, stop, xenv); scheme_set_local_syntax(19, scheme_modulestar_stx, stop, xenv); scheme_set_local_syntax(20, scheme_module_stx, stop, xenv); + scheme_set_local_syntax(21, declare_stx, stop, xenv); } else { w = scheme_sys_wraps_phase_worker(phase); s = scheme_datum_to_syntax(scheme_intern_symbol("begin"), scheme_false, w, 0, 0); @@ -9609,6 +9662,8 @@ static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **_beg scheme_set_local_syntax(19, s, stop, xenv); s = scheme_datum_to_syntax(scheme_intern_symbol("module"), scheme_false, w, 0, 0); scheme_set_local_syntax(20, s, stop, xenv); + s = scheme_datum_to_syntax(scheme_intern_symbol("#%declare"), scheme_false, w, 0, 0); + scheme_set_local_syntax(21, s, stop, xenv); } } @@ -11839,7 +11894,7 @@ void parse_requires(Scheme_Object *form, int at_phase, int *all_simple, Scheme_Hash_Table *modidx_cache, Scheme_Hash_Table *submodule_names, - int *maybe_phaseless) + int *non_phaseless) /* form can be a module-path index or a quoted require spec */ { Scheme_Object *ll = form, *mode = scheme_make_integer(0), *just_mode = NULL, *x_mode, *x_just_mode; @@ -12184,8 +12239,8 @@ void parse_requires(Scheme_Object *form, int at_phase, start ? eval_exp : 0, start ? eval_run : 0, main_env->phase, scheme_null, 0); - if (maybe_phaseless && !m->phaseless) - *maybe_phaseless = 0; + if (non_phaseless && !m->phaseless) + *non_phaseless |= NON_PHASELESS_IMPORT; x_just_mode = just_mode; x_mode = mode; @@ -12452,3 +12507,18 @@ provide_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *er scheme_wrong_syntax(NULL, NULL, form, "not in module body"); return NULL; } + +static Scheme_Object * +declare_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec) +{ + scheme_wrong_syntax(NULL, NULL, form, "not in module body"); + return NULL; +} + +static Scheme_Object * +declare_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec) +{ + SCHEME_EXPAND_OBSERVE_PRIM_PROVIDE(erec[drec].observer); + scheme_wrong_syntax(NULL, NULL, form, "not in module body"); + return NULL; +} diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 409192e995..f2d198ed8d 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "5.90.0.1" +#define MZSCHEME_VERSION "5.90.0.2" #define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_Y 90 #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)