fix package so that syntax-local-value works after define*
svn: r14021
This commit is contained in:
parent
54157130d6
commit
44e7744646
|
@ -291,7 +291,7 @@
|
||||||
(let ([star? (free-identifier=? #'def #'define*-syntaxes)]
|
(let ([star? (free-identifier=? #'def #'define*-syntaxes)]
|
||||||
[ids (syntax->list #'(id ...))])
|
[ids (syntax->list #'(id ...))])
|
||||||
(let* ([def-ctx (if star?
|
(let* ([def-ctx (if star?
|
||||||
(syntax-local-make-definition-context)
|
(syntax-local-make-definition-context (car def-ctxes))
|
||||||
(car def-ctxes))]
|
(car def-ctxes))]
|
||||||
[ids (if star?
|
[ids (if star?
|
||||||
(map (add-package-context (list def-ctx)) ids)
|
(map (add-package-context (list def-ctx)) ids)
|
||||||
|
|
|
@ -198,7 +198,9 @@ Returns @scheme[#t] if @scheme[v] is an @tech{internal-definition
|
||||||
context}, @scheme[#f] otherwise.}
|
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
|
Creates an opaque @tech{internal-definition context} value to be used
|
||||||
with @scheme[local-expand] and other functions. A transformer should
|
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
|
added; if an unsealed @tech{internal-definition context} is detected
|
||||||
in a fully expanded expression, the @exnraise[exn:fail:contract].
|
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[]}
|
@transform-time[]}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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-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-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-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-seal", intdef_context_seal, 1, 1, env);
|
||||||
GLOBAL_PRIM_W_ARITY("internal-definition-context?", intdef_context_p, 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);
|
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 *
|
static Scheme_Object *
|
||||||
local_make_intdef_context(int argc, Scheme_Object *argv[])
|
local_make_intdef_context(int argc, Scheme_Object *argv[])
|
||||||
{
|
{
|
||||||
Scheme_Comp_Env *env;
|
Scheme_Comp_Env *env, *senv;
|
||||||
Scheme_Object *c, *rib;
|
Scheme_Object *c, *rib;
|
||||||
|
|
||||||
env = scheme_current_thread->current_local_env;
|
env = scheme_current_thread->current_local_env;
|
||||||
if (!env)
|
if (!env)
|
||||||
scheme_raise_exn(MZEXN_FAIL_CONTRACT, "syntax-local-make-definition-context: not currently transforming");
|
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();
|
rib = scheme_make_rename_rib();
|
||||||
|
|
||||||
c = scheme_alloc_object();
|
c = scheme_alloc_object();
|
||||||
|
|
Loading…
Reference in New Issue
Block a user