From 4a7c4d184c3d93ad2189ea83fd2cb4a804b58984 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 11 Aug 2018 17:21:53 -0600
Subject: [PATCH] optimizer: don't drop application when argument count is
 wrong

Guard some ad hoc optimizations with an arity check in the cases of 1
or 2 arguments.

Closes #2222
---
 .../tests/racket/optimize.rktl                | 70 +++++++++++++------
 racket/src/racket/src/optimize.c              |  8 ++-
 2 files changed, 54 insertions(+), 24 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl
index 6e434d5cd3..238341630d 100644
--- a/pkgs/racket-test-core/tests/racket/optimize.rktl
+++ b/pkgs/racket-test-core/tests/racket/optimize.rktl
@@ -3823,32 +3823,44 @@
 ;; Types related to arithmetic
 
 (let ()
-  (define (check-real-op op [can-omit? #t] [can-multi? #t])
+  (define (check-real-op op [can-omit? #t] [can-multi? #t]
+                         #:implies-real? [implies-real? #t]
+                         #:needs-two-args? [needs-two-args? #f])
     (test-comp `(lambda (x y)
                  (list (,op x y)
-                       (real? x)
-                       (real? y)
                        (number? x)
                        (number? y)))
                `(lambda (x y)
                  (list (,op x y)
-                       #t
-                       #t
                        #t
                        #t)))
+    (when implies-real?
+      (test-comp `(lambda (x y)
+                    (list (,op x y)
+                          (real? x)
+                          (real? y)
+                          (number? x)
+                          (number? y)))
+                 `(lambda (x y)
+                    (list (,op x y)
+                          #t
+                          #t
+                          #t
+                          #t))))
     (when can-multi?
-      (test-comp `(lambda (x y z w)
-                   (list (,op x y z w)
-                         (real? x)
-                         (real? y)
-                         (real? z)
-                         (real? w)))
-                 `(lambda (x y z w)
-                   (list (,op x y z w)
-                         #t
-                         #t
-                         #t
-                         #t))))
+      (let ([? (if implies-real? 'real? 'number?)])
+        (test-comp `(lambda (x y z w)
+                      (list (,op x y z w)
+                            (,? x)
+                            (,? y)
+                            (,? z)
+                            (,? w)))
+                   `(lambda (x y z w)
+                      (list (,op x y z w)
+                            #t
+                            #t
+                            #t
+                            #t)))))
     (when can-omit?
       (test-comp `(lambda (x y)
                    (if (and (real? x) (real? y))
@@ -3859,16 +3871,30 @@
                  `(lambda (x y)
                    (if (and (real? x) (real? y))
                        (,op x y)
-                       (error "bad"))))))
+                       (error "bad"))))
+      ;; Make sure error is not discarded when the number
+      ;; of arguments is wrong
+      (when needs-two-args?
+        (test-comp `(lambda (x)
+                      (if (real? x)
+                          (let ([tmp (= x)])
+                            'whatever)
+                          (error "bad")))
+                 `(lambda (x)
+                    (if (real? x)
+                        (= x)
+                        (error "bad")))))))
+
   (check-real-op 'quotient #f #f)
   (check-real-op 'remainder #f #f)
   (check-real-op 'modulo #f #f)
   (check-real-op 'max)
   (check-real-op 'min)
-  (check-real-op '<)
-  (check-real-op '>)
-  (check-real-op '<=)
-  (check-real-op '>=)
+  (check-real-op '= #:needs-two-args? #t #:implies-real? #f)
+  (check-real-op '< #:needs-two-args? #t)
+  (check-real-op '> #:needs-two-args? #t)
+  (check-real-op '<= #:needs-two-args? #t)
+  (check-real-op '>= #:needs-two-args? #t)
 
   (define (check-number-op op [closed-under-reals? #t])
     (test-comp `(lambda (x y)
diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c
index 7ab318c16c..e8c67aedd8 100644
--- a/racket/src/racket/src/optimize.c
+++ b/racket/src/racket/src/optimize.c
@@ -4417,7 +4417,9 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
     rator = scheme_values_proc;
   }
 
-  if (SCHEME_PRIMP(rator)) {
+  if (SCHEME_PRIMP(rator)
+      && (1 >= ((Scheme_Primitive_Proc *)rator)->mina)
+      && (1 <= ((Scheme_Primitive_Proc *)rator)->mu.maxa)) {
     /* Check for things like (cXr (cons X Y)): */
     switch (SCHEME_TYPE(rand)) {
     case scheme_application2_type:
@@ -5080,7 +5082,9 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
     }
   }
 
-  if (SCHEME_PRIMP(app->rator)) {
+  if (SCHEME_PRIMP(app->rator)
+      && (2 >= ((Scheme_Primitive_Proc *)app->rator)->mina)
+      && (2 <= ((Scheme_Primitive_Proc *)app->rator)->mu.maxa)) {
     Scheme_Object *app_o = (Scheme_Object *)app, *rator = app->rator, *rand1 = app->rand1, *rand2 = app->rand2;
 
     if (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & SCHEME_PRIM_AD_HOC_OPT) {