fix performance problem in expander

For a term

 (lambda (arg-id ...) (define def-id _rhs) ... (arg-id def-id) ...)

the expander could take quadratic time in the number of `def-id`s
due to walking an environment to remove use-site scopes. (The
variant of the expander rewritten in Racket didn't have this
problem.)

pkgs/racket-test-core/tests/racket/optimize.rktl

@@ -6008,6 +6008,37 @@
       (for ([s (in-list 'obviously-not-a-list)])
         (unknown random-configuration)))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Make sure the expander and compiler don't go quadratic
+;; for
+;;  (lambda (arg-id ...) (define def-id _rhs) ... (arg-id def-id) ...)
+
+(let ()
+  (define (gensym-n n)
+    (let loop ([i n])
+      (if (zero? i)
+          '()
+          (cons (gensym) (loop (sub1 i))))))
+
+  (define (time-it n)
+    (let ([start (current-process-milliseconds)])
+      (let* ([args (gensym-n n)]
+             [defns (gensym-n n)])
+        (eval
+         `(lambda ,args
+            ,@(map (lambda (defn) `(define ,defn ',defn)) defns)
+            ,@(map (lambda (arg defn) `(,arg ,defn)) args defns))))
+      (- (current-process-milliseconds) start)))
+
+  (let loop ([tries 3])
+    (let ([a (time-it 100)]
+          [b (time-it 1000)])
+      ;; n lg(n) is ok, n^2 is not
+      (when (b . > . (* 50 a))
+        (if (zero? tries)
+            (test 'fail "compilation took too long" (/ b a 1.0))
+            (loop (sub1 tries)))))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/src/racket/src/compenv.c

@@ -262,6 +262,13 @@ Scheme_Comp_Env *scheme_new_compilation_frame(int num_bindings, int flags, Schem
 
   init_compile_data(frame);
 
+  if (flags & SCHEME_USE_SCOPES_TO_NEXT) {
+    if (base->use_scopes_next)
+      frame->use_scopes_next = base->use_scopes_next;
+    else
+      frame->use_scopes_next = base;
+  }
+
   return frame;
 }
 

racket/src/racket/src/compile.c

@@ -792,9 +792,13 @@ Scheme_Object *scheme_revert_use_site_scopes(Scheme_Object *o, Scheme_Comp_Env *
                                                   SCHEME_STX_REMOVE);
     }
     if (env->flags & (SCHEME_FOR_INTDEF | SCHEME_INTDEF_FRAME | SCHEME_INTDEF_SHADOW)) {
-      env = env->next;
-      if (!env)
-        break;
+      if (env->use_scopes_next)
+        env = env->use_scopes_next;
+      else {
+        env = env->next;
+        if (!env)
+          break;
+      }
     } else
       break;
   }

racket/src/racket/src/mzmark_compenv.inc

@@ -16,6 +16,7 @@ static int mark_comp_env_MARK(void *p, struct NewGC *gc) {
   gcMARK2(e->insp, gc);
   gcMARK2(e->prefix, gc);
   gcMARK2(e->next, gc);
+  gcMARK2(e->use_scopes_next, gc);
   gcMARK2(e->scopes, gc);
   gcMARK2(e->value_name, gc);
   gcMARK2(e->observer, gc);
@@ -54,6 +55,7 @@ static int mark_comp_env_FIXUP(void *p, struct NewGC *gc) {
   gcFIXUP2(e->insp, gc);
   gcFIXUP2(e->prefix, gc);
   gcFIXUP2(e->next, gc);
+  gcFIXUP2(e->use_scopes_next, gc);
   gcFIXUP2(e->scopes, gc);
   gcFIXUP2(e->value_name, gc);
   gcFIXUP2(e->observer, gc);

racket/src/racket/src/mzmarksrc.c

@@ -1293,6 +1293,7 @@ mark_comp_env {
   gcMARK2(e->insp, gc);
   gcMARK2(e->prefix, gc);
   gcMARK2(e->next, gc);
+  gcMARK2(e->use_scopes_next, gc);
   gcMARK2(e->scopes, gc);
   gcMARK2(e->value_name, gc);
   gcMARK2(e->observer, gc);

racket/src/racket/src/schpriv.h

@@ -2881,6 +2881,7 @@ typedef struct Scheme_Comp_Env
   Scheme_Object *expand_result_adjust_arg;
 
   struct Scheme_Comp_Env *next;
+  struct Scheme_Comp_Env *use_scopes_next; /* fast-forward for use-site scope revert */
 } Scheme_Comp_Env;
 
 #define LAMBDA_HAS_REST 1

racket/src/racket/src/syntax.c

@@ -1284,7 +1284,7 @@ Scheme_Object *scheme_stx_adjust_scopes(Scheme_Object *o, Scheme_Scope_Set *scop
   return stx_adjust_scopes(o, scopes, phase, mode, &mutate);
 }
 
-/* For each continuation frame, we need to keep track of various sets of scopes:
+/* For each environment frame, we need to keep track of various sets of scopes:
     - bind scopes (normally 0 or 1) are created for the binding context
     - use-site scopes are created for macro expansions that need them
     - intdef scopes are for immediately nested internal-definition contexts;