fix expand[-syntax[-to-top-form]]
to add namespace's scope
Make `expand` more consistent with `eval` and with the old expander.
This commit is contained in:
parent
94e5b1723b
commit
6beff43439
|
@ -1335,6 +1335,26 @@
|
||||||
#'#t)])
|
#'#t)])
|
||||||
(void (m)))
|
(void (m)))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
;; Check that `expand-syntax` attaches the namespace's
|
||||||
|
|
||||||
|
(test 573
|
||||||
|
'expand
|
||||||
|
(parameterize ([current-namespace (make-base-namespace)])
|
||||||
|
(eval '(require (for-syntax racket/base)))
|
||||||
|
(eval '(define-syntax (m stx)
|
||||||
|
(with-syntax ([id (datum->syntax #f 'gen-id)])
|
||||||
|
#`(begin
|
||||||
|
(define id 573)
|
||||||
|
id))))
|
||||||
|
(define stx (namespace-syntax-introduce (datum->syntax #f '(m))))
|
||||||
|
(syntax-case (expand-syntax-to-top-form stx) (begin)
|
||||||
|
[(begin a b)
|
||||||
|
(begin
|
||||||
|
(eval-syntax #'a)
|
||||||
|
(eval-syntax (expand-syntax #'b)))])))
|
||||||
|
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -4620,6 +4620,12 @@ static void *expand_k(void)
|
||||||
obj = scheme_top_introduce(obj, env->genv);
|
obj = scheme_top_introduce(obj, env->genv);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (rename && env->genv->stx_context) {
|
||||||
|
obj = scheme_stx_push_introduce_module_context(obj, env->genv->stx_context);
|
||||||
|
env->expand_result_adjust = scheme_stx_push_introduce_module_context;
|
||||||
|
env->expand_result_adjust_arg = env->genv->stx_context;
|
||||||
|
}
|
||||||
|
|
||||||
observer = scheme_get_expand_observe();
|
observer = scheme_get_expand_observe();
|
||||||
SCHEME_EXPAND_OBSERVE_START_EXPAND(observer);
|
SCHEME_EXPAND_OBSERVE_START_EXPAND(observer);
|
||||||
|
|
||||||
|
@ -4694,10 +4700,6 @@ static void *expand_k(void)
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (rename && !just_to_top) {
|
|
||||||
/* scheme_simplify_stx(obj, scheme_new_stx_simplify_cache()); */ /* too expensive */
|
|
||||||
}
|
|
||||||
|
|
||||||
return obj;
|
return obj;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user