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

wrap each top-level form in a module with a prompt

Browse Source 
svn: r17917
This commit is contained in:
Matthew Flatt 2010-01-31 17:04:55 +00:00
parent de98d4fd79
commit 5433c57504
6 changed files with 89 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/scribblings/reference/syntax.scrbl
View File

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

12
collects/tests/mzscheme/optimize.ss
View File

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

53
collects/tests/mzscheme/thread.ss
View File

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

3
doc/release-notes/mzscheme/HISTORY.txt
View File

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

43
src/mzscheme/src/module.c
View File

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

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

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