local-expand: fix argument checking

Also, fix contract in the docs, since the first argument is allowed to
be an S-expression.
This commit is contained in:
Matthew Flatt 2015-08-13 11:45:00 -06:00
parent 86ee9c5071
commit 7741b4b361
3 changed files with 29 additions and 8 deletions

View File

@ -197,7 +197,7 @@ field value is not an identifier, then an identifier @racketidfont{?}
with an empty context is used, instead.}
@defproc[(local-expand [stx syntax?]
@defproc[(local-expand [stx any/c]
[context-v (or/c 'expression 'top-level 'module 'module-begin list?)]
[stop-ids (or/c (listof identifier?) #f)]
[intdef-ctx (or/c internal-definition-context?
@ -211,7 +211,9 @@ Expands @racket[stx] in the lexical context of the expression
currently being expanded. The @racket[context-v] argument is used as
the result of @racket[syntax-local-context] for immediate expansions;
a list indicates an @tech{internal-definition context}, and more
information on the form of the list is below.
information on the form of the list is below. If @racket[stx] is not
already a @tech{syntax object}, it is coerced with
@racket[(datum->syntax #f stx)] before expansion.
When an identifier in @racket[stop-ids] is encountered by the expander
in a sub-expression, expansions stops for the sub-expression. If
@ -297,7 +299,7 @@ generated value onto that list.
an explicit wrapper.}]}
@defproc[(syntax-local-expand-expression [stx syntax?])
@defproc[(syntax-local-expand-expression [stx any/c])
(values syntax? syntax?)]{
Like @racket[local-expand] given @racket['expression] and an empty
@ -316,7 +318,7 @@ avoids quadratic expansion times when local expansions are nested.
@transform-time[]}
@defproc[(local-transformer-expand [stx syntax?]
@defproc[(local-transformer-expand [stx any/c]
[context-v (or/c 'expression 'top-level list?)]
[stop-ids (or/c (listof identifier?) #f)]
[intdef-ctx (or/c internal-definition-context? #f) #f])
@ -331,7 +333,7 @@ lifted expressions---from calls to
result.}
@defproc[(local-expand/capture-lifts [stx syntax?]
@defproc[(local-expand/capture-lifts [stx any/c]
[context-v (or/c 'expression 'top-level 'module 'module-begin list?)]
[stop-ids (or/c (listof identifier?) #f)]
[intdef-ctx (or/c internal-definition-context? #f) #f]
@ -349,7 +351,7 @@ expressions are not expanded, but instead left as provided in the
@racket[begin] form.}
@defproc[(local-transformer-expand/capture-lifts [stx syntax?]
@defproc[(local-transformer-expand/capture-lifts [stx any/c]
[context-v (or/c 'expression 'top-level list?)]
[stop-ids (or/c (listof identifier?) #f)]
[intdef-ctx (or/c internal-definition-context? #f) #f]

View File

@ -1258,6 +1258,23 @@
(def)
(use)))
;; ----------------------------------------
;; Check `local-expand` argument checking
(let-syntax ([m
(lambda (stx)
(define (le . args)
(with-handlers ([exn:fail:contract? void])
(apply local-expand args)
(error "fail")))
(le #'1 'xpression null)
(le #'1 'expression 1)
(le #'1 'expression #'1)
(le #'1 'expression #'(x))
(le #'1 'expression (list 'x))
#'#t)])
(void (m)))
;; ----------------------------------------
(report-errs)

View File

@ -5160,9 +5160,11 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
if (for_expr) {
} else if (SCHEME_TRUEP(argv[2])) {
# define NUM_CORE_EXPR_STOP_FORMS 15
cnt = scheme_stx_proper_list_length(argv[2]);
cnt = scheme_proper_list_length(argv[2]);
if (cnt == 1)
if ((cnt == 1)
&& SCHEME_STXP(SCHEME_CAR(argv[2]))
&& SCHEME_SYMBOLP(SCHEME_STX_VAL(SCHEME_CAR(argv[2]))))
is_modstar = scheme_stx_free_eq_x(scheme_modulestar_stx, SCHEME_CAR(argv[2]), env->genv->phase);
else
is_modstar = 0;