local-expand' allows a stop list to have only
module*'
That is, when the sto plist contains only `module*', core forms are not implicitly added to the stop list.
This commit is contained in:
parent
941f215aa0
commit
fbb6a294f3
|
@ -1117,16 +1117,10 @@
|
|||
[(vector? arg) `(array ,(vector-length arg)
|
||||
,(if (zero? (vector-length arg))
|
||||
'int
|
||||
(for/fold ([t (arg-to-type (vector-ref arg 0) (add1 in-array))]) ([v (in-vector arg)])
|
||||
(define t2 (arg-to-type v (add1 in-array)))
|
||||
(let loop ([t t] [t2 t2])
|
||||
(cond
|
||||
[(equal? t t2) t]
|
||||
[(and (pair? t) (pair? t2)
|
||||
(eq? (car t) 'array) (eq? (car t2) 'array)
|
||||
(equal? (cadr t) (cadr t2)))
|
||||
`(array ,(cadr t) ,(loop (caddr t) (caddr t2)))]
|
||||
[else 'any])))))]
|
||||
(for/fold ([t (arg-to-type (vector-ref arg 0))]) ([v (in-vector arg)])
|
||||
(if (equal? t (arg-to-type v))
|
||||
t
|
||||
'any))))]
|
||||
[(in-array . > . 1) 'any]
|
||||
[(boolean? arg) 'boolean]
|
||||
[(signed-int? arg 32) 'int]
|
||||
|
|
|
@ -472,7 +472,7 @@ for booleans; the first of @racket['int], @racket['unsigned-int],
|
|||
@racket['com-object] and @racket['iunknown] for corresponding COM object references;
|
||||
and an @racket['array] type for a vector, where the element type is inferred
|
||||
from vector values, resorting to @racket['any] if any two elements have different
|
||||
inferred types or if the array is multidimensional.
|
||||
inferred types.
|
||||
|
||||
|
||||
@defproc[(type-description? [v any/c]) boolean?]{
|
||||
|
|
|
@ -200,7 +200,7 @@ information on the form of the list is below.
|
|||
|
||||
When an identifier in @racket[stop-ids] is encountered by the expander
|
||||
in a sub-expression, expansions stops for the sub-expression. If
|
||||
@racket[stop-ids] is a non-empty list, then
|
||||
@racket[stop-ids] is a non-empty list and does not contain just @racket[module*], then
|
||||
@racket[begin], @racket[quote], @racket[set!], @racket[lambda],
|
||||
@racket[case-lambda], @racket[let-values], @racket[letrec-values],
|
||||
@racket[if], @racket[begin0], @racket[with-continuation-mark],
|
||||
|
|
|
@ -459,6 +459,17 @@
|
|||
(define q 8)
|
||||
(nab h))
|
||||
|
||||
;; #'module* in sto plist shouldn't add all the rest:
|
||||
(let ()
|
||||
(define-syntax (m stx) (syntax-case stx ()
|
||||
[(_ e)
|
||||
(let ([e (local-expand #'e 'expression (list #'module*))])
|
||||
(syntax-case e (#%plain-app quote)
|
||||
[(#%plain-app + (quote 1) (quote 2)) 'ok]
|
||||
[else (error 'test "bad local-expand result: ~e" e)])
|
||||
#'(void))]))
|
||||
(m (+ 1 2)))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module rename-transformer-tests scheme/base
|
||||
|
|
|
@ -3,7 +3,11 @@ racket/base: add progress-evt?, thread-cell-values?, prefab-key?,
|
|||
semaphore-peek-evt?, channel-put-evt?
|
||||
Changed #lang for most languages so that it cannot be nested;
|
||||
this change is within syntax/module-reader and applies to
|
||||
racket, racket/base, and more
|
||||
racket, racket/base, and morea
|
||||
racket/com: don't always infer 'any for the element type of a
|
||||
multidimensional array
|
||||
Changed local-expand to not add core forms if the stop list has
|
||||
just module*
|
||||
|
||||
Version 5.3.0.9
|
||||
Changed the format of error messages
|
||||
|
|
|
@ -4669,7 +4669,7 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
|
|||
{
|
||||
Scheme_Comp_Env *env, *orig_env, **ip;
|
||||
Scheme_Object *l, *local_mark, *renaming = NULL, *orig_l, *exp_expr = NULL;
|
||||
int cnt, pos, kind;
|
||||
int cnt, pos, kind, is_modstar;
|
||||
int bad_sub_env = 0, bad_intdef = 0;
|
||||
Scheme_Object *observer, *catch_lifts_key = NULL;
|
||||
|
||||
|
@ -4785,8 +4785,15 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
|
|||
} else if (SCHEME_TRUEP(argv[2])) {
|
||||
# define NUM_CORE_EXPR_STOP_FORMS 15
|
||||
cnt = scheme_stx_proper_list_length(argv[2]);
|
||||
|
||||
if (cnt == 1)
|
||||
is_modstar = scheme_stx_module_eq_x(scheme_modulestar_stx, SCHEME_CAR(argv[2]), env->genv->phase);
|
||||
else
|
||||
is_modstar = 0;
|
||||
|
||||
if (cnt > 0) {
|
||||
cnt += NUM_CORE_EXPR_STOP_FORMS;
|
||||
if (!is_modstar)
|
||||
cnt += NUM_CORE_EXPR_STOP_FORMS;
|
||||
scheme_add_local_syntax(cnt, env);
|
||||
}
|
||||
pos = 0;
|
||||
|
@ -4808,7 +4815,7 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
|
|||
return NULL;
|
||||
}
|
||||
|
||||
if (cnt > 0) {
|
||||
if ((cnt > 0) && !is_modstar) {
|
||||
scheme_add_core_stop_form(pos++, begin_symbol, env);
|
||||
scheme_add_core_stop_form(pos++, scheme_intern_symbol("set!"), env);
|
||||
scheme_add_core_stop_form(pos++, app_symbol, env);
|
||||
|
|
Loading…
Reference in New Issue
Block a user