fix optimizer bug for inlining procedures under 'let' in rator position

svn: r18622

collects/tests/mzscheme/optimize.ss

@@ -1148,6 +1148,42 @@
 (err/rt-test (cwv-2-5-f (lambda () 1) (lambda (y z) (+ y 2))) exn:fail:contract:arity?)
 (err/rt-test (cwv-2-5-f (lambda () (values 1 2 3)) (lambda (y z) (+ y 2))) exn:fail:contract:arity?)
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Inlining with higher-order functions:
+
+(test 0 'ho1 (let ([x (random 1)])
+               ((let ([fn (add1 (random 1))])
+                  (lambda (c) c))
+                x)))
+(test 0 'ho2 (let ([x (random 1)]
+                   [id (lambda (c) c)])
+               ((let ([fn (add1 (random 1))])
+                  id)
+                x)))
+(test 0 'ho3 (let ([proc (lambda (q)
+                           (let ([fn (add1 (random 1))])
+                             (lambda (c) c)))])
+               (let ([x (random 1)])
+                 ((proc 99) x))))
+(test '(2 0) 'ho4 (let ([y (+ 2 (random 1))])
+                    (let ([x (random 1)])
+                      ((let ([fn (add1 (random 1))])
+                         (lambda (c) (list y c)))
+                       x))))
+(test '(2 0) 'ho5 (let ([y (+ 2 (random 1))])
+                    (let ([x (random 1)]
+                          [id (lambda (c) (list y c))])
+                      ((let ([fn (add1 (random 1))])
+                         id)
+                       x))))
+(test '(2 0) 'ho6 (let ([y (+ 2 (random 1))])
+                    (let ([proc (lambda (q)
+                                  (let ([fn (add1 (random 1))])
+                                    (lambda (c) (list y c))))])
+                      (let ([x (random 1)])
+                        ((proc 98)
+                         x)))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

src/mzscheme/src/eval.c

@@ -2436,19 +2436,18 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
 {
   Scheme_Let_Header *lh;
   Scheme_Compiled_Let_Value *lv, *prev = NULL;
+  Scheme_Object *val;
   int i, expected;
   int *flags, flag;
 
   expected = data->num_params;
 
   if (!expected) {
-    info = scheme_optimize_info_add_frame(info, nested_count, nested_count, 0);
+    info = scheme_optimize_info_add_frame(info, 0, 0, 0);
     info->inline_fuel >>= 1;
-    if (nested_count) info->vclock++;
     p = scheme_optimize_expr(p, info, context);
     info->next->single_result = info->single_result;
-    if (!nested_count)
+    info->next->preserves_marks = info->preserves_marks;
-      info->next->preserves_marks = info->preserves_marks;
     scheme_optimize_info_done(info);
 
     if (le_prev) {
@@ -2472,7 +2471,7 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
     if ((i == expected - 1)
         && (SCHEME_CLOSURE_DATA_FLAGS(data) & CLOS_HAS_REST)) {
       int j;
-      Scheme_Object *l = scheme_null, *val;
+      Scheme_Object *l = scheme_null;
 
       for (j = argc; j-- > i; ) {
         if (app)
@@ -2488,14 +2487,16 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
       }
       l = cons(scheme_list_proc, l);
       val = make_application(l);
-      
-      lv->value = val;
     } else if (app)
-      lv->value = app->args[i + 1];
+      val = app->args[i + 1];
     else if (app3)
-      lv->value = (i ? app3->rand2 : app3->rand1);
+      val = (i ? app3->rand2 : app3->rand1);
-    else if (app2)
+    else
-      lv->value = app2->rand;
+      val = app2->rand;
+
+    if (nested_count)
+      val = scheme_optimize_shift(val, nested_count, 0);
+    lv->value = val;
 
     flag = scheme_closure_argument_flags(data, i);
     flags = (int *)scheme_malloc_atomic(sizeof(int));
@@ -2514,7 +2515,7 @@ static Scheme_Object *apply_inlined(Scheme_Object *p, Scheme_Closure_Data *data,
   else
     lh->body = p;
 
-  p = scheme_optimize_lets((Scheme_Object *)lh, info, 1 + nested_count, context);
+  p = scheme_optimize_lets((Scheme_Object *)lh, info, 1, context);
 
   if (le_prev) {
     *((Scheme_Object **)(((char *)le_prev) + prev_offset)) = p;
@@ -2538,7 +2539,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
   int offset = 0, single_use = 0, psize = 0;
   Scheme_Object *bad_app = NULL, *prev = NULL, *orig_le = le;
   long prev_offset = 0;
-  int nested_count = 0;
+  int nested_count = 0, outside_nested = 0;
 
   if (info->inline_fuel < 0)
     return NULL;
@@ -2568,9 +2569,10 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
 
   if (!optimized_rator && SAME_TYPE(SCHEME_TYPE(le), scheme_local_type)) {
     /* Check for inlining: */
-    if (SCHEME_LOCAL_POS(le) >= nested_count)
+    if (SCHEME_LOCAL_POS(le) >= nested_count) {
       le = scheme_optimize_info_lookup(info, SCHEME_LOCAL_POS(le) - nested_count, &offset, &single_use, 0, 0, &psize);
-    else
+      outside_nested = 1;
+    } else
       info->has_nonleaf = 1;
   }
 
@@ -2587,6 +2589,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
         }
         if (!le)
           break;
+        outside_nested = 1;
       } else
         break;
     }
@@ -2616,16 +2619,25 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
 
       if ((sz >= 0) && (single_use || (sz <= threshold))) {
         Optimize_Info *sub_info;
-        if (nested_count)
+        if (nested_count) {
-          sub_info = scheme_optimize_info_add_frame(info, nested_count, nested_count, 0);
+          sub_info = scheme_optimize_info_add_frame(info, nested_count, nested_count, nested_count);
-        else
+          sub_info->vclock++;
+          /* We could propagate bound values in sub_info , but relevant inlining
+             and propagatation has probably already happened when the rator was
+             optimized. */
+        } else
           sub_info = info;
-	le = scheme_optimize_clone(0, data->code, sub_info, offset, data->num_params);
+	le = scheme_optimize_clone(0, data->code, sub_info, 
+                                   offset + (outside_nested ? nested_count : 0), 
+                                   data->num_params);
 	if (le) {
 	  LOG_INLINE(fprintf(stderr, "Inline %d[%d]<=%d@%d %d %s\n", sz, is_leaf, threshold, info->inline_fuel,
                              single_use, data->name ? scheme_write_to_string(data->name, NULL) : "???"));
-          return apply_inlined(le, data, info, argc, app, app2, app3, context,
+          le = apply_inlined(le, data, sub_info, argc, app, app2, app3, context,
-                               nested_count, orig_le, prev, prev_offset);
+                             nested_count, orig_le, prev, prev_offset);
+          if (nested_count)
+            scheme_optimize_info_done(sub_info);
+          return le;
 	} else {
           LOG_INLINE(fprintf(stderr, "No inline %s\n", data->name ? scheme_write_to_string(data->name, NULL) : "???"));
           info->has_nonleaf = 1;
@@ -2857,33 +2869,30 @@ static void reset_rator(Scheme_Object *app, Scheme_Object *a)
 static Scheme_Object *check_app_let_rator(Scheme_Object *app, Scheme_Object *rator, Optimize_Info *info, 
                                           int argc, int context)
 {
+  /* Convert ((let (....) E) arg ...) to (let (....) (E arg ...)), in case
+     the `let' is immediately apparent. We check for this pattern again
+     in optimize_for_inline() after optimizing a rator. */
   if (SAME_TYPE(SCHEME_TYPE(rator), scheme_compiled_let_void_type)) {
     Scheme_Let_Header *head = (Scheme_Let_Header *)rator;
-
+    Scheme_Compiled_Let_Value *clv = NULL;
-    if ((head->count == 1) && (head->num_clauses == 1)) {
+    int i;
-      Scheme_Object *body;
+    
-      Scheme_Compiled_Let_Value *clv;
+    rator = head->body;
-
+    for (i = head->num_clauses; i--; ) {
-      clv = (Scheme_Compiled_Let_Value *)head->body;
+      clv = (Scheme_Compiled_Let_Value *)rator;
-      body = clv->body;
+      rator = clv->body;
-      if (SAME_TYPE(SCHEME_TYPE(body), scheme_local_type)
-          && (SCHEME_LOCAL_POS(body) == 0)
-          && scheme_is_compiled_procedure(clv->value, 1, 1)) {
-        
-        reset_rator(app, scheme_false);
-        app = scheme_optimize_shift(app, 1, 0);
-        reset_rator(app, scheme_make_local(scheme_local_type, 0, 0));
-
-        clv->body = app;
-        
-        if (clv->flags[0] & SCHEME_WAS_APPLIED_EXCEPT_ONCE) {
-          clv->flags[0] -= SCHEME_WAS_APPLIED_EXCEPT_ONCE;
-          clv->flags[0] |= SCHEME_WAS_ONLY_APPLIED;
-        }
-        
-        return scheme_optimize_expr(rator, info, context);
-      }
     }
+
+    reset_rator(app, scheme_false);
+    app = scheme_optimize_shift(app, head->count, 0);
+    reset_rator(app, rator);
+
+    if (clv)
+      clv->body = app;
+    else
+      head->body = app;
+    
+    return scheme_optimize_expr((Scheme_Object *)head, info, context);
   }
 
   return NULL;

src/mzscheme/src/syntax.c

@@ -3098,15 +3098,9 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
     }
   }
 
-  if (for_inline > 1) {
+  body_info = scheme_optimize_info_add_frame(info, head->count, head->count, 0);
-    info->vclock++;
-    sub_info = scheme_optimize_info_add_frame(info, for_inline - 1, for_inline - 1, 0);
-  } else
-    sub_info = info;
-
-  body_info = scheme_optimize_info_add_frame(sub_info, head->count, head->count, 0);
   if (for_inline) {
-    rhs_info = scheme_optimize_info_add_frame(info, 0, head->count + (for_inline - 1), 0);
+    rhs_info = scheme_optimize_info_add_frame(info, 0, head->count, 0);
     body_info->inline_fuel >>= 1;
   } else
     rhs_info = body_info;
@@ -3562,7 +3556,6 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
   /* Optimized away all clauses? */
   if (!head->num_clauses) {
     scheme_optimize_info_done(body_info);
-    if (for_inline > 1) scheme_optimize_info_done(sub_info);
     return head->body;
   }
   
@@ -3616,20 +3609,18 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
       value = scheme_optimize_clone(1, value, rhs_info, 0, 0);
 
       if (value) {
-        info = scheme_optimize_info_add_frame(sub_info, extract_depth, 0, 0);
+        sub_info = scheme_optimize_info_add_frame(info, extract_depth, 0, 0);
-        info->inline_fuel = 0;
+        sub_info->inline_fuel = 0;
-        value = scheme_optimize_expr(value, info, context);
+        value = scheme_optimize_expr(value, sub_info, context);
-        sub_info->single_result = info->single_result;
+        info->single_result = sub_info->single_result;
-        sub_info->preserves_marks = info->preserves_marks;
+        info->preserves_marks = sub_info->preserves_marks;
-        scheme_optimize_info_done(info);
+        scheme_optimize_info_done(sub_info);
-        if (for_inline > 1) scheme_optimize_info_done(sub_info);
         return value;
       }
     }
   }
 
   scheme_optimize_info_done(body_info);
-  if (for_inline > 1) scheme_optimize_info_done(sub_info);
 
   return form;
 }