suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

optimizer: don't drop application when argument count is wrong

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

Closes #2222
This commit is contained in:
Matthew Flatt 2018-08-11 17:21:53 -06:00
parent 305d02f46a
commit 4a7c4d184c
2 changed files with 54 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
pkgs/racket-test-core/tests/racket/optimize.rktl
View File

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

8
racket/src/racket/src/optimize.c
View File

@ -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) {