From feb8f10165a087756699dfab8f636b84c6889eb9 Mon Sep 17 00:00:00 2001
From: Gustavo Massaccesi <gustavo@oma.org.ar>
Date: Thu, 1 Jan 2015 18:16:41 -0300
Subject: [PATCH] Mark error in expression when an arity mismatch is detected
 during optimization

This enables further reductions, for example (begin (car x x) z) => (car x x)
---
 .../tests/racket/optimize.rktl                | 10 ++++++-
 racket/src/racket/src/optimize.c              | 26 ++++++++++++++++---
 2 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl
index 1da94bca11..871cd3eb7e 100644
--- a/pkgs/racket-test-core/tests/racket/optimize.rktl
+++ b/pkgs/racket-test-core/tests/racket/optimize.rktl
@@ -1358,7 +1358,15 @@
                 (begin0 y (set! y 5)))))
 
 (test-comp '(lambda (w) (car w) (mcar w))
-           '(lambda (w) (begin (car w) (mcar w) (random))))
+           '(lambda (w) (car w) (mcar w) (random)))
+(test-comp '(lambda (w) (car w w))
+           '(lambda (w) (car w w) (random)))
+(test-comp '(lambda (w) (car w w w))
+           '(lambda (w) (car w w w) (random)))
+(test-comp '(lambda (w) (cons w))
+           '(lambda (w) (cons w) (random)))
+(test-comp '(lambda (w) (cons))
+           '(lambda (w) (cons) (random)))
 
 ; test for unary aplications
 (test-comp -1
diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c
index 212934fcd7..575dd99bc9 100644
--- a/racket/src/racket/src/optimize.c
+++ b/racket/src/racket/src/optimize.c
@@ -1930,6 +1930,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
   if (bad_app) {
     int len;
     const char *pname, *context;
+    info->escapes = 1;
     pname = scheme_get_proc_name(bad_app, &len, 0);
     context = scheme_optimize_context_to_string(info->context);
     scheme_log(info->logger,
@@ -2575,7 +2576,7 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
 {
   Scheme_Object *le;
   Scheme_App_Rec *app;
-  int i, n, rator_flags = 0, sub_context = 0;
+  int i, n, rator_apply_escapes = 0, rator_flags = 0, sub_context = 0;
   Optimize_Info_Sequence info_seq;
 
   app = (Scheme_App_Rec *)o;
@@ -2630,12 +2631,12 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
       return scheme_make_sequence_compilation(l, 1);
     }
 
-
     if (!i) {
       /* Maybe found "((lambda" after optimizing; try again */
       le = optimize_for_inline(info, app->args[i], n - 1, app, NULL, NULL, &rator_flags, context, 1);
       if (le)
         return le;
+      rator_apply_escapes = info->escapes;
     }
   }
 
@@ -2656,6 +2657,11 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
     app->args[3] = ((Scheme_Closure_Data *)app->args[3])->code;
   }
 
+  if (rator_apply_escapes) {
+   info->escapes = 1;
+   SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
+  }
+
   return finish_optimize_application(app, info, context, rator_flags);
 }
 
@@ -2930,7 +2936,7 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
 {
   Scheme_App2_Rec *app;
   Scheme_Object *le;
-  int rator_flags = 0, sub_context, ty;
+  int rator_flags = 0, rator_apply_escapes, sub_context, ty;
   Optimize_Info_Sequence info_seq;
 
   app = (Scheme_App2_Rec *)o;
@@ -2959,6 +2965,7 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
     le = optimize_for_inline(info, app->rator, 1, NULL, app, NULL, &rator_flags, context, 1);
     if (le)
       return le;
+    rator_apply_escapes = info->escapes;
   }
 
   if (SAME_PTR(scheme_not_prim, app->rator)){
@@ -2979,6 +2986,11 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
     return make_discarding_first_sequence(app->rator, app->rand, info, 0);
   }
 
+  if (rator_apply_escapes) {
+   info->escapes = 1;
+   SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
+  }
+
   return finish_optimize_application2(app, info, context, rator_flags);
 }
 
@@ -3235,7 +3247,7 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
 {
   Scheme_App3_Rec *app;
   Scheme_Object *le;
-  int rator_flags = 0, sub_context, ty, flags;
+  int rator_flags = 0, rator_apply_escapes, sub_context, ty, flags;
   Optimize_Info_Sequence info_seq;
 
   app = (Scheme_App3_Rec *)o;
@@ -3279,6 +3291,7 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
     le = optimize_for_inline(info, app->rator, 2, NULL, NULL, app, &rator_flags, context, 1);
     if (le)
       return le;
+    rator_apply_escapes = info->escapes;
   }
 
   /* 1st arg */
@@ -3324,6 +3337,11 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
   flags = appn_flags(app->rator, info);
   SCHEME_APPN_FLAGS(app) |= flags;
 
+  if (rator_apply_escapes) {
+   info->escapes = 1;
+   SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
+  }
+
   return finish_optimize_application3(app, info, context, rator_flags);
 }