From 5433c57504c0471778236fbf952f123531cb1659 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 31 Jan 2010 17:04:55 +0000 Subject: [PATCH] wrap each top-level form in a module with a prompt svn: r17917 --- collects/scribblings/reference/syntax.scrbl | 15 +++--- collects/tests/mzscheme/optimize.ss | 12 ++--- collects/tests/mzscheme/thread.ss | 53 +++++++++++---------- doc/release-notes/mzscheme/HISTORY.txt | 3 ++ src/mzscheme/src/module.c | 43 ++++++++++++++++- src/mzscheme/src/schvers.h | 4 +- 6 files changed, 89 insertions(+), 41 deletions(-) diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl index 2aafe83deb..f09b9f9741 100644 --- a/collects/scribblings/reference/syntax.scrbl +++ b/collects/scribblings/reference/syntax.scrbl @@ -95,7 +95,7 @@ id)] is the name of the declared module. @margin-note/ref{For a @scheme[module]-like form for use @emph{within} modules and other contexts, see @scheme[define-package].} -The @scheme[module-path] must be as for @scheme[require], and it +The @scheme[module-path] form must be as for @scheme[require], and it supplies the initial bindings for the body @scheme[form]s. That is, it is treated like a @scheme[(require module-path)] prefix before the @scheme[form]s, except that the bindings introduced by @@ -179,10 +179,13 @@ module, whose full name depends both on @scheme[id] and The module body is executed only when the module is explicitly @techlink{instantiate}d via @scheme[require] or @scheme[dynamic-require]. On invocation, expressions and definitions -are evaluated in order as they appear within the module; accessing a -@tech{module-level variable} before it is defined signals a run-time -error, just like accessing an undefined global variable. +are evaluated in order as they appear within the module. Each +evaluation of an expression or definition is wrapped with a +continuation prompt (see @scheme[call-with-continuation-prompt]) for +the default continuation and using the default prompt handler. +Accessing a @tech{module-level variable} before it is defined signals +a run-time error, just like accessing an undefined global variable. If a module (in its fully expanded form) does not contain a @scheme[set!] for an identifier that defined within the module, then the identifier is a @defterm{constant} after it is defined; its value @@ -218,8 +221,8 @@ See also @secref["module-eval-model"] and @secref["mod-parse"]. Legal only in a @tech{module begin context}, and handled by the @scheme[module] form. -The pre-defined @scheme[#%module-begin] form wraps every -top-level expression to print non-@|void-const| results using +The @scheme[#%module-begin] form of @schememodname[scheme/base] wraps +every top-level expression to print non-@|void-const| results using @scheme[current-print].} @defform[(#%plain-module-begin form ...)]{ diff --git a/collects/tests/mzscheme/optimize.ss b/collects/tests/mzscheme/optimize.ss index 4647044eb2..66b681acea 100644 --- a/collects/tests/mzscheme/optimize.ss +++ b/collects/tests/mzscheme/optimize.ss @@ -534,7 +534,7 @@ (un0 '#&1 'box 1) (let ([test-setter - (lambda (make-X def-val set-val set-name set ref) + (lambda (make-X def-val set-val set-name set ref 3rd-all-ok?) (let ([v (make-X 3 def-val)]) (check-error-message set-name (eval `(lambda (x) (,set-name ,v -1 ,set-val)))) (check-error-message set-name (eval `(lambda (x) (,set-name ,v 3 ,set-val)))) @@ -547,12 +547,12 @@ (test def-val ref v (modulo (+ i 1) 3)) (test def-val ref v (modulo (+ i 2) 3)) (set v i def-val)) - #t)) + 3rd-all-ok?)) '(0 1 2))))]) - (test-setter make-vector #f 7 'vector-set! vector-set! vector-ref) - (test-setter make-bytes 0 7 'bytes-set! bytes-set! bytes-ref) - (test-setter make-string #\a #\7 'string-set! string-set! string-ref) - (test-setter make-flvector 1.0 7.0 'flvector-set! flvector-set! flvector-ref)) + (test-setter make-vector #f 7 'vector-set! vector-set! vector-ref #t) + (test-setter make-bytes 0 7 'bytes-set! bytes-set! bytes-ref #f) + (test-setter make-string #\a #\7 'string-set! string-set! string-ref #f) + (test-setter make-flvector 1.0 7.0 'flvector-set! flvector-set! flvector-ref #f)) )) diff --git a/collects/tests/mzscheme/thread.ss b/collects/tests/mzscheme/thread.ss index 832f33f3d3..35b0dcfe7e 100644 --- a/collects/tests/mzscheme/thread.ss +++ b/collects/tests/mzscheme/thread.ss @@ -1319,32 +1319,33 @@ (run #t)) ;; Make sure that transitive thread-resume keeps a weak link -;; when thread is blocked: -(let ([run - (lambda (suspend-first?) - (let ([done (make-semaphore)]) - (let ([boxes - (for/list ([i (in-range 100)]) - (let ([t - (thread (lambda () - (semaphore-wait (make-semaphore)) - (semaphore-post done)))]) - (when suspend-first? - (sync (system-idle-evt)) - (thread-suspend t)) - (thread-resume t (current-thread)) - (make-weak-box t)))]) - (sync (system-idle-evt)) - (collect-garbage) - (collect-garbage) - (test #t > (apply + (map (lambda (b) (if (weak-box-value b) - 0 - 1)) - boxes)) - 50) - (test #f sync/timeout 0.0 done))))]) - (run #f) - (run #t)) +;; when thread is blocked (but only test under 3m): +(when (regexp-match #rx"3m" (path->bytes (system-library-subpath))) + (let ([run + (lambda (suspend-first?) + (let ([done (make-semaphore)]) + (let ([boxes + (for/list ([i (in-range 100)]) + (let ([t + (thread (lambda () + (semaphore-wait (make-semaphore)) + (semaphore-post done)))]) + (when suspend-first? + (sync (system-idle-evt)) + (thread-suspend t)) + (thread-resume t (current-thread)) + (make-weak-box t)))]) + (sync (system-idle-evt)) + (collect-garbage) + (collect-garbage) + (test #t > (apply + (map (lambda (b) (if (weak-box-value b) + 0 + 1)) + boxes)) + 50) + (test #f sync/timeout 0.0 done))))]) + (run #f) + (run #t))) ; -------------------- diff --git a/doc/release-notes/mzscheme/HISTORY.txt b/doc/release-notes/mzscheme/HISTORY.txt index 6c5c211139..6d453d777a 100644 --- a/doc/release-notes/mzscheme/HISTORY.txt +++ b/doc/release-notes/mzscheme/HISTORY.txt @@ -1,3 +1,6 @@ +Version 4.2.4.2 +Changed module to wrap each body expression in a prompt + Version 4.2.4, January 2010 Added scheme/flonum and scheme/fixnum Extended scheme/unsafe/ops diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index f8f526d521..6410018f49 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -4403,6 +4403,44 @@ static void eval_module_body(Scheme_Env *menv, Scheme_Env *env) #endif } +static Scheme_Object *body_one_expr(void *expr, int argc, Scheme_Object **argv) +{ + return _scheme_eval_linked_expr_multi((Scheme_Object *)expr); +} + +static int needs_prompt(Scheme_Object *e) +{ + Scheme_Type t; + + while (1) { + t = SCHEME_TYPE(e); + if (t > _scheme_values_types_) + return 0; + + switch (t) { + case scheme_unclosed_procedure_type: + case scheme_toplevel_type: + case scheme_local_type: + case scheme_local_unbox_type: + return 0; + case scheme_syntax_type: + switch (SCHEME_PINT_VAL(e)) { + case CASE_LAMBDA_EXPD: + return 0; + case DEFINE_VALUES_EXPD: + e = (Scheme_Object *)SCHEME_IPTR_VAL(e); + e = SCHEME_VEC_ELS(e)[0]; + break; + default: + return 1; + } + break; + default: + return 1; + } + } +} + void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env) { Scheme_Thread *p; @@ -4459,7 +4497,10 @@ void *scheme_module_run_finish(Scheme_Env *menv, Scheme_Env *env) cnt = SCHEME_VEC_SIZE(m->body); for (i = 0; i < cnt; i++) { body = SCHEME_VEC_ELS(m->body)[i]; - _scheme_eval_linked_expr_multi(body); + if (needs_prompt(body)) + (void)_scheme_call_with_prompt_multi(body_one_expr, body); + else + (void)_scheme_eval_linked_expr_multi(body); } if (scheme_module_demand_hook) { diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index 8881496a34..65375a4149 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "4.2.4.1" +#define MZSCHEME_VERSION "4.2.4.2" #define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_Y 2 #define MZSCHEME_VERSION_Z 4 -#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)