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:
parent
86ee9c5071
commit
7741b4b361
|
@ -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]
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue
Block a user