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

add syntax-transforming-module-expression?', variable-reference->module-base-phase'

Browse Source
This commit is contained in:
Matthew Flatt 2011-09-12 16:52:27 -06:00
parent c352ef8fce
commit b7bef3b3aa
10 changed files with 110 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/scribblings/reference/namespaces.scrbl
View File

@ -413,3 +413,13 @@ result is @racket[#f].}
Returns the @tech{phase} of the variable referenced by @racket[varref].}
@defproc[(variable-reference->module-base-phase [varref variable-reference?])
exact-nonnegative-integer?]{
Returns the @tech{phase} in which the module is instantiated for the
variable referenced by @racket[varref], or @racket[0] if the variable
for @racket[varref] is not within a module.
For a variable with a module, the result is less than the result of
@racket[(variable-reference->phase varref)] by @math{n} when the
variable is bound at @tech{phase level} @math{n} within the module.}

16
collects/scribblings/reference/stx-trans.scrbl
View File

@ -11,7 +11,8 @@
@(define (transform-time) @t{This procedure must be called during the
dynamic extent of a @tech{syntax transformer} application by the
expander or while a module is @tech{visit}ed, otherwise the
expander or while a module is @tech{visit}ed (see
@racket[syntax-transforming?]), otherwise the
@exnraise[exn:fail:contract].})
@ -516,7 +517,7 @@ transformed is not in the module top-level, then @racket[stx] is
eventually expanded in an expression context.
@transform-time[] If the current expression being transformed is not
within a @racket[module] form, or if it is not a run-time expression,
within a @racket[module] form (see @racket[syntax-transforming-module-expression?]),
then the @exnraise[exn:fail:contract].}
@ -554,8 +555,8 @@ Lifts a @racket[#%provide] form corresponding to
expanded or to an enclosing @racket[begin-for-syntax].
@transform-time[] If the current expression being transformed is not
within a @racket[module] form, or if it is not a run-time expression,
then the @exnraise[exn:fail:contract]. }
within a @racket[module] form (see @racket[syntax-transforming-module-expression?]),
then the @exnraise[exn:fail:contract].}
@defproc[(syntax-local-name) any/c]{
@ -654,6 +655,13 @@ transformer} application by the expander and while a module is being
@tech{visit}ed, @racket[#f] otherwise.}
@defproc[(syntax-transforming-module-expression?) boolean?]{
Returns @racket[#t] during the dynamic extent of a @tech{syntax
transformer} application by the expander for an expression
within a @racket[module] form, @racket[#f] otherwise.}
@defproc[(syntax-local-introduce [stx syntax?]) syntax?]{
Produces a syntax object that is like @racket[stx], except that a

25
collects/tests/racket/namespac.rktl
View File

@ -140,9 +140,12 @@
(module phaser scheme/base
(define x (variable-reference->phase
(#%variable-reference x)))
(provide x))
(define y (variable-reference->module-base-phase
(#%variable-reference y)))
(provide x y))
(test 0 dynamic-require ''phaser 'x)
(test 0 dynamic-require ''phaser 'y)
(let ([s (open-output-string)])
(parameterize ([current-output-port s])
@ -157,8 +160,24 @@
(let ([ns (make-base-namespace)])
(namespace-attach-module (current-namespace) ''phaser ns)
(eval '(require 'phaser) ns)
(display (eval 'x ns))))))
(test "1" get-output-string s))
(display (eval 'x ns))
(display (eval 'y ns))))))
(test "11" get-output-string s))
(let ([s (open-output-string)])
(parameterize ([current-output-port s])
(let ([ns (make-base-namespace)])
(eval '(module m racket/base
(require (for-syntax racket/base))
(begin-for-syntax
(define x 10)
(displayln (variable-reference->phase
(#%variable-reference x)))
(displayln (variable-reference->module-base-phase
(#%variable-reference x))))))
(eval '(require (for-syntax 'm)))
(eval '(begin-for-syntax 10))))
(test "1\n0\n2\n1\n" get-output-string s))
;; ----------------------------------------

25
collects/tests/racket/stx.rktl
View File

@ -1586,6 +1586,31 @@
(let-syntax ([g (lambda (stx) nonesuch)])
10))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; `syntax-transforming?' and `syntax-transforming-module-expression?'
(test #f syntax-transforming?)
(test #f syntax-transforming-module-expression?)
(test #t 'trans (let-syntax ([m (lambda (stx)
(datum->syntax stx (syntax-transforming?)))])
(m)))
(test #f 'trans-mod (let-syntax ([m (lambda (stx)
(datum->syntax stx (syntax-transforming-module-expression?)))])
(m)))
(let ([o (open-output-string)])
(parameterize ([current-output-port o])
(eval `(module m racket/base
(require (for-syntax racket/base))
(define-syntax (m stx)
(displayln (syntax-transforming-module-expression?))
#'1)
(m)))
(eval `(module m racket/base
(require (for-syntax racket/base))
(begin-for-syntax
(displayln (syntax-transforming-module-expression?))))))
(test "#t\n#f\n" get-output-string o))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

19
src/racket/src/compenv.c
View File

@ -2213,12 +2213,8 @@ scheme_local_lift_context(Scheme_Comp_Env *env)
return SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[4];
}
Scheme_Object *
scheme_local_lift_end_statement(Scheme_Object *expr, Scheme_Object *local_mark, Scheme_Comp_Env *env)
Scheme_Comp_Env *scheme_get_module_lift_env(Scheme_Comp_Env *env)
{
Scheme_Object *pr;
Scheme_Object *orig_expr;
while (env) {
if ((COMPILE_DATA(env)->lifts)
&& SCHEME_TRUEP(SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[3]))
@ -2226,10 +2222,21 @@ scheme_local_lift_end_statement(Scheme_Object *expr, Scheme_Object *local_mark,
env = env->next;
}
return env;
}
Scheme_Object *
scheme_local_lift_end_statement(Scheme_Object *expr, Scheme_Object *local_mark, Scheme_Comp_Env *env)
{
Scheme_Object *pr;
Scheme_Object *orig_expr;
env = scheme_get_module_lift_env(env);
if (!env)
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"syntax-local-lift-module-end-declaration: not currently transforming"
" a run-time expression in a module declaration");
" an expression within a module declaration");
expr = scheme_add_remove_mark(expr, local_mark);
orig_expr = expr;

10
src/racket/src/cstartup.inc
View File

@ -1,5 +1,5 @@
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,56,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,13,0,17,
0,22,0,29,0,42,0,49,0,54,0,59,0,63,0,70,0,73,0,82,0,
85,0,91,0,105,0,119,0,122,0,128,0,132,0,134,0,145,0,147,0,161,
@ -99,7 +99,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 2018);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,56,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,109,0,0,0,1,0,0,8,0,21,0,26,
0,43,0,65,0,94,0,109,0,127,0,143,0,157,0,179,0,195,0,212,0,
234,0,245,0,251,0,4,1,11,1,18,1,30,1,46,1,70,1,102,1,120,
@ -599,7 +599,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 10420);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,56,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0,57,
0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,175,1,
0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115,116,
@ -626,7 +626,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 496);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,56,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,65,0,0,0,1,0,0,7,0,18,0,45,
0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,158,0,170,0,185,0,
201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1,94,
@ -927,7 +927,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 6241);
}
{
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,55,0,0,0,0,0,0,0,0,0,0,0,
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,49,46,51,46,56,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,29,
0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,94,1,0,0,
69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,67,

19
src/racket/src/env.c
View File

@ -77,8 +77,10 @@ static Scheme_Object *variable_module_source(int, Scheme_Object *[]);
static Scheme_Object *variable_namespace(int, Scheme_Object *[]);
static Scheme_Object *variable_top_level_namespace(int, Scheme_Object *[]);
static Scheme_Object *variable_phase(int, Scheme_Object *[]);
static Scheme_Object *variable_base_phase(int, Scheme_Object *[]);
static Scheme_Object *variable_const_p(int, Scheme_Object *[]);
static Scheme_Object *now_transforming(int argc, Scheme_Object *argv[]);
static Scheme_Object *now_transforming_module(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_exp_time_value(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_exp_time_value_one(int argc, Scheme_Object *argv[]);
static Scheme_Object *local_exp_time_name(int argc, Scheme_Object *argv[]);
@ -641,6 +643,7 @@ static void make_kernel_env(void)
GLOBAL_PRIM_W_ARITY("variable-reference->empty-namespace", variable_namespace, 1, 1, env);
GLOBAL_PRIM_W_ARITY("variable-reference->namespace", variable_top_level_namespace, 1, 1, env);
GLOBAL_PRIM_W_ARITY("variable-reference->phase", variable_phase, 1, 1, env);
GLOBAL_PRIM_W_ARITY("variable-reference->module-base-phase", variable_base_phase, 1, 1, env);
REGISTER_SO(scheme_varref_const_p_proc);
scheme_varref_const_p_proc = scheme_make_prim_w_arity(variable_const_p,
@ -649,6 +652,7 @@ static void make_kernel_env(void)
scheme_add_global_constant("variable-reference-constant?", scheme_varref_const_p_proc, env);
GLOBAL_PRIM_W_ARITY("syntax-transforming?", now_transforming, 0, 0, env);
GLOBAL_PRIM_W_ARITY("syntax-transforming-module-expression?", now_transforming_module, 0, 0, env);
GLOBAL_PRIM_W_ARITY("syntax-local-value", local_exp_time_value, 1, 3, env);
GLOBAL_PRIM_W_ARITY("syntax-local-value/immediate", local_exp_time_value_one, 1, 3, env);
GLOBAL_PRIM_W_ARITY("syntax-local-name", local_exp_time_name, 0, 0, env);
@ -1675,6 +1679,8 @@ static Scheme_Object *do_variable_namespace(const char *who, int tl, int argc, S
ph = env->phase;
if (tl == 2) {
return scheme_make_integer(ph);
} else if (tl == 3) {
return scheme_make_integer(ph - env->mod_phase);
} else if (tl) {
/* return env directly; need to set up */
if (!env->phase && env->module)
@ -1705,6 +1711,11 @@ static Scheme_Object *variable_phase(int argc, Scheme_Object *argv[])
return do_variable_namespace("variable-reference->phase", 2, argc, argv);
}
static Scheme_Object *variable_base_phase(int argc, Scheme_Object *argv[])
{
return do_variable_namespace("variable-reference->phase", 3, argc, argv);
}
static Scheme_Object *variable_const_p(int argc, Scheme_Object *argv[])
{
Scheme_Object *v;
@ -1780,6 +1791,14 @@ now_transforming(int argc, Scheme_Object *argv[])
: scheme_false);
}
static Scheme_Object *
now_transforming_module(int argc, Scheme_Object *argv[])
{
if (scheme_get_module_lift_env(scheme_current_thread->current_local_env))
return scheme_true;
return scheme_false;
}
static Scheme_Object *
do_local_exp_time_value(const char *name, int argc, Scheme_Object *argv[], int recur)
{

2
src/racket/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1031
#define EXPECTED_PRIM_COUNT 1033
#define EXPECTED_UNSAFE_COUNT 78
#define EXPECTED_FLFXNUM_COUNT 68
#define EXPECTED_FUTURES_COUNT 11

1
src/racket/src/schpriv.h
View File

@ -2427,6 +2427,7 @@ Scheme_Object *scheme_local_lift_require(Scheme_Object *form, Scheme_Object *ori
Scheme_Comp_Env *env);
Scheme_Object *scheme_local_lift_provide(Scheme_Object *form, Scheme_Object *local_mark,
Scheme_Comp_Env *env);
Scheme_Comp_Env *scheme_get_module_lift_env(Scheme_Comp_Env *env);
void scheme_check_identifier(const char *formname, Scheme_Object *id,
const char *where,

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.1.3.7"
#define MZSCHEME_VERSION "5.1.3.8"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 3
#define MZSCHEME_VERSION_W 7
#define MZSCHEME_VERSION_W 8
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)