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:
Matthew Flatt 2012-06-07 15:55:40 +08:00
parent 941f215aa0
commit fbb6a294f3
6 changed files with 32 additions and 16 deletions

View File

@ -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]

View File

@ -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?]{

View File

@ -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],

View File

@ -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

View File

@ -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

View File

@ -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,7 +4785,14 @@ 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) {
if (!is_modstar)
cnt += NUM_CORE_EXPR_STOP_FORMS;
scheme_add_local_syntax(cnt, env);
}
@ -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);