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

add `#%declare', require declaration of cross-phase persistent modules

Browse Source
This commit is contained in:
Matthew Flatt 2013-07-22 10:34:39 -06:00
parent e1f4547ea9
commit 9e2cf2ab37
30 changed files with 200 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/deinprogramm/signature/module-begin.rkt
View File

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

2
pkgs/drracket-pkgs/drracket/drracket/private/syncheck/contract-traversal.rkt
View File

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

6
pkgs/drracket-pkgs/drracket/drracket/private/syncheck/traversals.rkt
View File

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

2
pkgs/drracket-pkgs/drracket/gui-debugger/annotator.rkt
View File

@ -184,6 +184,8 @@
stx #f
[(#%provide . provide-specs)
stx]
[(#%declare . declare-specs)
stx]
[else-stx
(general-top-level-expr-iterator stx module-name )]))

2
pkgs/errortrace-pkgs/errortrace-lib/errortrace/errortrace-key.rkt
View File

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

2
pkgs/errortrace-pkgs/errortrace-lib/errortrace/stacktrace.rkt
View File

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

11
pkgs/frtime/opt/frtime-opt.rkt
View File

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

7
pkgs/htdp-pkgs/htdp-lib/lang/private/teach-module-begin.rkt
View File

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

4
pkgs/htdp-pkgs/htdp-lib/stepper/private/annotate.rkt
View File

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

2
pkgs/htdp-pkgs/htdp-lib/stepper/private/lifting.rkt
View File

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

10
pkgs/racket-pkgs/racket-doc/scribblings/reference/eval-model.scrbl
View File

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

11
pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax-model.scrbl
View File

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

23
pkgs/racket-pkgs/racket-doc/scribblings/reference/syntax.scrbl
View File

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

10
pkgs/racket-pkgs/racket-test/tests/racket/cross-phase.rkt
View File

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

7
pkgs/scribble-pkgs/scribble-lib/scribble/doclang.rkt
View File

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

2
pkgs/scribble-pkgs/scribble-text-lib/scribble/text/syntax-utils.rkt
View File

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

2
pkgs/trace/stacktrace.rkt
View File

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

4
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/tc-setup.rkt
View File

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

1
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -214,6 +214,7 @@
;; these forms should always be ignored
[(#%require . _) (void)]
[(#%provide . _) (void)]
[(#%declare . _) (void)]
[(define-syntaxes . _) (void)]
[(begin-for-syntax . _) (void)]

3
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/arm.rkt
View File

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

3
pkgs/web-server-pkgs/web-server-lib/web-server/lang/util.rkt
View File

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

5
racket/collects/racket/HISTORY.txt
View File

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

2
racket/collects/racket/kernel.rkt
View File

@ -1,5 +1,7 @@
(module kernel '#%kernel
(#%provide (all-from '#%kernel))
(#%declare #:cross-phase-persistent)
(module reader syntax/module-reader
#:language 'racket/kernel))

4
racket/collects/racket/private/modbeg.rkt
View File

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

7
racket/collects/racket/splicing.rkt
View File

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

5
racket/collects/racket/tcp.rkt
View File

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

4
racket/collects/syntax/kerncase.rkt
View File

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

2
racket/collects/syntax/parse/private/litconv.rkt
View File

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

104
racket/src/racket/src/module.c
View File

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

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

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