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

fix `local-transformer-expand' with 'top-level context

Browse Source
This commit is contained in:
Matthew Flatt 2013-06-25 09:39:56 +02:00
parent 2f2bbd09cc
commit e51ac9cc61
3 changed files with 59 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/racket-pkgs/racket-doc/scribblings/reference/stx-trans.scrbl
View File

@ -313,13 +313,14 @@ avoids quadratic expansion times when local expansions are nested.
@defproc[(local-transformer-expand [stx syntax?]
[context-v (or/c 'expression 'top-level 'module 'module-begin list?)]
[context-v (or/c 'expression 'top-level list?)]
[stop-ids (or/c (listof identifier?) #f)]
[intdef-ctx (or/c internal-definition-context? #f) #f])
syntax?]{
Like @racket[local-expand], but @racket[stx] is expanded as a
transformer expression instead of a run-time expression, and any
transformer expression instead of a run-time expression.
For @racket['expression] expansion, any
lifted expressions---from calls to
@racket[syntax-local-lift-expression] during the expansion of
@racket[stx]---are captured into a @racket[let-values] form in the
@ -345,7 +346,7 @@ expressions are not expanded, but instead left as provided in the
@defproc[(local-transformer-expand/capture-lifts [stx syntax?]
[context-v (or/c 'expression 'top-level 'module 'module-begin list?)]
[context-v (or/c 'expression 'top-level list?)]
[stop-ids (or/c (listof identifier?) #f)]
[intdef-ctx (or/c internal-definition-context? #f) #f]
[lift-ctx any/c (gensym 'lifts)])

47
pkgs/racket-pkgs/racket-test/tests/racket/macro.rktl
View File

@ -591,6 +591,53 @@
(syntax-local-bind-syntaxes (list 'q) #'1 context)))
(test 'ok 'ok (foo)))
;; ----------------------------------------
(test '(+ 1 2)
'local-transformer-expand/expr
(let-syntax ([m (lambda (stx)
(define e (local-transformer-expand #'(+ 1 2) 'expression (list #'#%app)))
#`(quote #,e))])
(m)))
(test '(define-values (x) '3)
'local-transformer-expand/top-level
(let-syntax ([m (lambda (stx)
(define e (local-transformer-expand #'(define x 3) 'top-level null))
#`(quote #,e))])
(m)))
(module check-transformer-lift racket/base
(require (for-syntax racket/base
(for-syntax racket/base)))
(provide e d)
(begin-for-syntax
(define-syntax (n stx)
(syntax-local-lift-expression #'5)
#'ok))
(define e
(let-syntax ([m (lambda (stx)
(define e (local-transformer-expand #'(n) 'expression (list #'#%app)))
#`(quote #,e))])
(m)))
(define d
(let-syntax ([m (lambda (stx)
(define e (local-transformer-expand/capture-lifts #'(n) 'top-level (list #'#%app)))
#`(quote #,e))])
(m))))
(require syntax/datum)
(test #t
'local-transformer-expand/lift
(datum-case (dynamic-require ''check-transformer-lift 'e) (let-values ok)
[(let-values (((lifted) 5)) ok) #t]
[x (datum x)]))
(test #t
'local-transformer-expand/lift
(datum-case (dynamic-require ''check-transformer-lift 'd) (begin define-values ok)
[(begin (define-values (lifted) 5) ok) #t]
[x (datum x)]))
;; ----------------------------------------
;; Check `#%variable-reference' expansion to make sure
;; a lexically bound identifier is made consistent with

13
racket/src/racket/src/eval.c
View File

@ -4799,19 +4799,22 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
if (for_expr)
kind = 0; /* expression */
else if (SAME_OBJ(argv[1], module_symbol))
else if (!for_stx && SAME_OBJ(argv[1], module_symbol))
kind = SCHEME_MODULE_BEGIN_FRAME; /* name is backwards compared to symbol! */
else if (SAME_OBJ(argv[1], module_begin_symbol))
else if (!for_stx && SAME_OBJ(argv[1], module_begin_symbol))
kind = SCHEME_MODULE_FRAME; /* name is backwards compared to symbol! */
else if (SAME_OBJ(argv[1], top_level_symbol))
else if (SAME_OBJ(argv[1], top_level_symbol)) {
kind = SCHEME_TOPLEVEL_FRAME;
else if (SAME_OBJ(argv[1], expression_symbol))
if (catch_lifts < 0) catch_lifts = 0;
} else if (SAME_OBJ(argv[1], expression_symbol))
kind = 0;
else if (scheme_proper_list_length(argv[1]) > 0)
kind = SCHEME_INTDEF_FRAME;
else {
scheme_wrong_contract(name,
"(or/c 'expression 'module 'module-begin 'top-level (and/c pair? list?))",
(for_stx
? "(or/c 'expression 'top-level (and/c pair? list?))"
: "(or/c 'expression 'module 'module-begin 'top-level (and/c pair? list?))"),
1, argc, argv);
return NULL;
}