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

fix expand of `#%variable-reference' on local variable

Browse Source 
Closes PR 12231
This commit is contained in:
Matthew Flatt 2011-09-27 18:53:28 -06:00
parent ec49225112
commit 2ae6d0c55f
2 changed files with 38 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/tests/racket/macro.rktl
View File

@ -547,6 +547,25 @@
(syntax-local-bind-syntaxes (list 'q) #'1 context)))
(test 'ok 'ok (foo)))
;; ----------------------------------------
;; Check `#%variable-reference' expansion to make sure
;; a lexically bound identifier is made consistent with
;; its binding
(module m-check-varref-expand racket
(define-syntax (m stx)
(syntax-case stx ()
[(_ e)
;; use `local-expand' to trigger re-expansion:
(local-expand #'e 'expression null)]))
(m
(let ([x 10])
(define-syntax-rule (q) (#%variable-reference x))
;; `q' introduces a marked `x' under `#%variable-reference':
(q))))
(require 'm-check-varref-expand)
;; ----------------------------------------
(report-errs)

27
src/racket/src/compile.c
View File

@ -1326,7 +1326,7 @@ static Scheme_Object *
ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec, int drec)
{
Scheme_Env *menv = NULL;
Scheme_Object *var, *name, *rest, *dummy;
Scheme_Object *var, *name, *rest, *dummy, *lex_id = NULL;
int l, ok;
form = scheme_stx_taint_disarm(form, NULL);
@ -1378,6 +1378,7 @@ ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
else
var = scheme_expand_expr(name, env, rec, drec);
} else {
lex_id = NULL;
var = scheme_lookup_binding(name, env,
SCHEME_REFERENCING
+ SCHEME_GLOB_ALWAYS_REFERENCE
@ -1388,7 +1389,7 @@ ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
? SCHEME_RESOLVE_MODIDS
: 0),
env->in_modidx,
&menv, NULL, NULL);
&menv, NULL, &lex_id);
if (SAME_TYPE(SCHEME_TYPE(var), scheme_variable_type)
|| SAME_TYPE(SCHEME_TYPE(var), scheme_module_variable_type)) {
@ -1418,20 +1419,30 @@ ref_syntax (Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
SCHEME_PTR1_VAL(o) = (Scheme_Object *)var;
SCHEME_PTR2_VAL(o) = (Scheme_Object *)dummy;
return o;
} else
return scheme_void;
} else {
if (lex_id) {
form = SCHEME_STX_CAR(form);
return scheme_make_pair(form, scheme_make_pair(lex_id, scheme_null));
}
return NULL;
}
}
static Scheme_Object *
ref_expand(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Expand_Info *erec, int drec)
{
Scheme_Object *naya;
SCHEME_EXPAND_OBSERVE_PRIM_VARREF(erec[drec].observer);
/* Error checking: */
ref_syntax(form, env, erec, drec);
/* Error checking, and lexical variable update: */
naya = ref_syntax(form, env, erec, drec);
/* No change: */
return form;
if (!naya)
/* No change: */
return form;
return scheme_datum_to_syntax(naya, form, form, 0, 2);
}
/**********************************************************************/