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

fix package so that syntax-local-value works after define*

Browse Source 
svn: r14021
This commit is contained in:
Matthew Flatt 2009-03-09 13:24:34 +00:00
parent 54157130d6
commit 44e7744646
3 changed files with 22 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/scheme/package.ss
View File

@ -291,7 +291,7 @@
(let ([star? (free-identifier=? #'def #'define*-syntaxes)]
[ids (syntax->list #'(id ...))])
(let* ([def-ctx (if star?
(syntax-local-make-definition-context)
(syntax-local-make-definition-context (car def-ctxes))
(car def-ctxes))]
[ids (if star?
(map (add-package-context (list def-ctx)) ids)

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

@ -198,7 +198,9 @@ Returns @scheme[#t] if @scheme[v] is an @tech{internal-definition
context}, @scheme[#f] otherwise.}
@defproc[(syntax-local-make-definition-context) internal-definition-context?]{
@defproc[(syntax-local-make-definition-context
[intdef-ctx (or/c internal-definition-context? #f) #f])
internal-definition-context?]{
Creates an opaque @tech{internal-definition context} value to be used
with @scheme[local-expand] and other functions. A transformer should
@ -212,6 +214,11 @@ Finally, the transformer must call
added; if an unsealed @tech{internal-definition context} is detected
in a fully expanded expression, the @exnraise[exn:fail:contract].
If @scheme[intdef-ctx] is not @scheme[#f], then the new
internal-definition context extends the given one. That is, expanding
in the new internal-definition context can use bindings previously
introduced into @scheme[intdef-ctx].
@transform-time[]}

15
src/mzscheme/src/env.c
View File

@ -525,7 +525,7 @@ static void make_kernel_env(void)
GLOBAL_PRIM_W_ARITY("syntax-local-name", local_exp_time_name, 0, 0, env);
GLOBAL_PRIM_W_ARITY("syntax-local-context", local_context, 0, 0, env);
GLOBAL_PRIM_W_ARITY("syntax-local-phase-level", local_phase_level, 0, 0, env);
GLOBAL_PRIM_W_ARITY("syntax-local-make-definition-context", local_make_intdef_context, 0, 0, env);
GLOBAL_PRIM_W_ARITY("syntax-local-make-definition-context", local_make_intdef_context, 0, 1, env);
GLOBAL_PRIM_W_ARITY("internal-definition-context-seal", intdef_context_seal, 1, 1, env);
GLOBAL_PRIM_W_ARITY("internal-definition-context?", intdef_context_p, 1, 1, env);
GLOBAL_PRIM_W_ARITY("identifier-remove-from-definition-context", id_intdef_remove, 2, 2, env);
@ -4305,13 +4305,24 @@ local_phase_level(int argc, Scheme_Object *argv[])
static Scheme_Object *
local_make_intdef_context(int argc, Scheme_Object *argv[])
{
Scheme_Comp_Env *env;
Scheme_Comp_Env *env, *senv;
Scheme_Object *c, *rib;
env = scheme_current_thread->current_local_env;
if (!env)
scheme_raise_exn(MZEXN_FAIL_CONTRACT, "syntax-local-make-definition-context: not currently transforming");
if (argc && SCHEME_TRUEP(argv[0])) {
if (!SAME_TYPE(scheme_intdef_context_type, SCHEME_TYPE(argv[0])))
scheme_wrong_type("syntax-local-bind-syntaxes", "internal-definition context or #f", 0, argc, argv);
senv = (Scheme_Comp_Env *)SCHEME_PTR1_VAL(argv[0]);
if (!scheme_is_sub_env(senv, env)) {
scheme_raise_exn(MZEXN_FAIL_CONTRACT, "syntax-local-make-definition-context: transforming context does "
"not match given internal-definition context");
}
env = senv;
}
rib = scheme_make_rename_rib();
c = scheme_alloc_object();