avoid generating unnecessary struct-accessor and -mutator names

svn: r14566

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])
+				  [make make]
-		      (syntax/loc stx (make class-expr `name))))]
+                                  [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-accessor) "class" (list #'#t))
-       (mk (quote-syntax make-class-field-mutator) "class")
+       (mk (quote-syntax make-class-field-mutator) "class" (list #'#t))
-       (mk (quote-syntax make-generic/proc) "class or interface"))))
+       (mk (quote-syntax make-generic/proc) "class or interface" null))))
 
   (define-syntax (class-field-accessor-traced stx)
     (syntax-case stx ()

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].}
 

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);
 

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])) {
+    if (SCHEME_FALSEP(argv[2])) {
-      scheme_wrong_type(who, "symbol", 2, argc, argv);
+      fieldstr = NULL;
-      return 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 {