diff --git a/collects/scheme/private/class-internal.ss b/collects/scheme/private/class-internal.ss index 289dd7ff8e..a0831ca2d3 100644 --- a/collects/scheme/private/class-internal.ss +++ b/collects/scheme/private/class-internal.ss @@ -1327,9 +1327,9 @@ rename-super-temp ... rename-super-extra-temp ... rename-inner-temp ... rename-inner-extra-temp ... method-accessor ...) ; for a local call that needs a dynamic lookup - (let ([local-field-accessor (make-struct-field-accessor local-accessor local-field-pos)] + (let ([local-field-accessor (make-struct-field-accessor local-accessor local-field-pos #f)] ... - [local-field-mutator (make-struct-field-mutator local-mutator local-field-pos)] + [local-field-mutator (make-struct-field-mutator local-mutator local-field-pos #f)] ...) (syntax-parameterize ([this-param (make-this-map (quote-syntax this-id) @@ -2102,9 +2102,9 @@ ;; Use public field names to name the accessors and mutators (let-values ([(inh-accessors inh-mutators) (values - (map (lambda (id) (make-class-field-accessor super id)) + (map (lambda (id) (make-class-field-accessor super id #f)) inherit-field-names) - (map (lambda (id) (make-class-field-mutator super id)) + (map (lambda (id) (make-class-field-mutator super id #f)) inherit-field-names))]) ;; -- Reset field table to register accessor and mutator info -- ;; There are more accessors and mutators than public fields... @@ -2959,7 +2959,7 @@ (loop (wrapper-object-wrapped loop-object))))))) - (define (class-field-X who which cwhich class name) + (define (class-field-X who which cwhich class name proc-field-name) (unless (class? class) (raise-type-error who "class" class)) (unless (symbol? name) @@ -2969,17 +2969,17 @@ (obj-error who "no such field: ~a~a" name (for-class (class-name class)))))]) - (which (cwhich (car p)) (cdr p) name))) + (which (cwhich (car p)) (cdr p) proc-field-name))) - (define (make-class-field-accessor class name) + (define (make-class-field-accessor class name keep-name?) (class-field-X 'class-field-accessor make-struct-field-accessor class-field-ref - class name)) + class name (and keep-name? name))) - (define (make-class-field-mutator class name) + (define (make-class-field-mutator class name keep-name?) (class-field-X 'class-field-mutator make-struct-field-mutator class-field-set! - class name)) + class name (and keep-name? name))) (define-struct generic (name applicable)) @@ -3060,7 +3060,7 @@ (define-syntaxes (class-field-accessor class-field-mutator generic/form) (let ([mk - (lambda (make targets) + (lambda (make targets extra-args) (lambda (stx) (syntax-case stx () [(_ class-expr name) @@ -3072,8 +3072,9 @@ stx name)) (with-syntax ([name (localize name)] - [make make]) - (syntax/loc stx (make class-expr `name))))] + [make make] + [extra-args extra-args]) + (syntax/loc stx (make class-expr `name . extra-args))))] [(_ class-expr) (raise-syntax-error #f @@ -3081,9 +3082,9 @@ targets) stx)])))]) (values - (mk (quote-syntax make-class-field-accessor) "class") - (mk (quote-syntax make-class-field-mutator) "class") - (mk (quote-syntax make-generic/proc) "class or interface")))) + (mk (quote-syntax make-class-field-accessor) "class" (list #'#t)) + (mk (quote-syntax make-class-field-mutator) "class" (list #'#t)) + (mk (quote-syntax make-generic/proc) "class or interface" null)))) (define-syntax (class-field-accessor-traced stx) (syntax-case stx () diff --git a/collects/scribblings/reference/struct.scrbl b/collects/scribblings/reference/struct.scrbl index 554580ed8c..b4bb35bf2e 100644 --- a/collects/scribblings/reference/struct.scrbl +++ b/collects/scribblings/reference/struct.scrbl @@ -237,7 +237,8 @@ The result of @scheme[make-struct-type] is five values: @defproc[(make-struct-field-accessor [accessor-proc struct-accessot-procedure?] [field-pos exact-nonnegative-integer?] - [field-name symbol?]) + [field-name (or/c symbol? #f) + (symbol->string (format "field~a" field-pos))]) procedure?]{ Returns a field accessor that is equivalent to @scheme[(lambda (s) @@ -245,13 +246,14 @@ Returns a field accessor that is equivalent to @scheme[(lambda (s) an @tech{accessor} returned by @scheme[make-struct-type]. The name of the resulting procedure for debugging purposes is derived from @scheme[field-name] and the name of @scheme[accessor-proc]'s -structure type. +structure type if @scheme[field-name] is a symbol. For examples, see @scheme[make-struct-type].} @defproc[(make-struct-field-mutator [mutator-proc struct-mutator-procedure?] [field-pos exact-nonnegative-integer?] - [field-name symbol?]) + [field-name (or/c symbol? #f) + (symbol->string (format "field~a" field-pos))]) procedure?]{ Returns a field mutator that is equivalent to @scheme[(lambda (s v) @@ -259,7 +261,7 @@ Returns a field mutator that is equivalent to @scheme[(lambda (s v) a @tech{mutator} returned by @scheme[make-struct-type]. The name of the resulting procedure for debugging purposes is derived from @scheme[field-name] and the name of @scheme[mutator-proc]'s -structure type. +structure type if @scheme[field-name] is a symbol. For examples, see @scheme[make-struct-type].} diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index a430ec9e62..9791eff342 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -2863,12 +2863,13 @@ static int generate_app(Scheme_App_Rec *app, Scheme_Object **alt_rands, int num_ if (reorder_ok) { if (no_call < 2) { - generate(rator, jitter, 0, 0, JIT_V1); /* sync'd below */ + generate(rator, jitter, 0, 0, JIT_V1); /* sync'd below, or not */ } CHECK_LIMIT(); } - mz_rs_sync(); + if (!no_call) + mz_rs_sync(); END_JIT_DATA(20); diff --git a/src/mzscheme/src/struct.c b/src/mzscheme/src/struct.c index d3f23a65ab..1c86cd4b8e 100644 --- a/src/mzscheme/src/struct.c +++ b/src/mzscheme/src/struct.c @@ -2164,19 +2164,29 @@ static Scheme_Object *make_struct_field_xxor(const char *who, int getter, pos = parse_pos(who, i, argv, argc); if (argc > 2) { - if (!SCHEME_SYMBOLP(argv[2])) { - scheme_wrong_type(who, "symbol", 2, argc, argv); - return NULL; + if (SCHEME_FALSEP(argv[2])) { + fieldstr = NULL; + fieldstrlen = 0; + } else { + if (!SCHEME_SYMBOLP(argv[2])) { + scheme_wrong_type(who, "symbol or #f", 2, argc, argv); + return NULL; + } + fieldstr = scheme_symbol_val(argv[2]); + fieldstrlen = SCHEME_SYM_LEN(argv[2]); } - fieldstr = scheme_symbol_val(argv[2]); - fieldstrlen = SCHEME_SYM_LEN(argv[2]); } else { sprintf(digitbuf, "field%d", (int)SCHEME_INT_VAL(argv[1])); fieldstr = digitbuf; fieldstrlen = strlen(fieldstr); } - if (getter) { + if (!fieldstr) { + if (getter) + name = "accessor"; + else + name = "mutator"; + } else if (getter) { name = (char *)GET_NAME((char *)i->struct_type->name, -1, fieldstr, fieldstrlen, 0); } else {