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

extend reductions for eq? to expressions with eqv? and equal?

Browse Source 
The relevant predicates are almost disjoint. The superposition
is solved with predicate_implies and predicate_implies_not.

This is also valid considering the equivalence classes modulo
eqv? and equal?. So if the optimizer knows that two expressions
X and Y have different relevant types, then it can reduce
(equal? X Y) ==> (begin X Y #f).
This commit is contained in:
Gustavo Massaccesi 2016-07-21 22:27:01 -03:00
parent 99b35a5d08
commit 8bb79deaa2
2 changed files with 51 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1093,7 +1093,32 @@
`(letrec ([x (,e? y y)]
[y (random)])
(list x x y y))
#f))])
#f)
(test-comp `(lambda (x y) (when (and (pair? x) (box? y)) (,e? x y)))
`(lambda (x y) (when (and (pair? x) (box? y)) #f)))
(test-comp `(lambda (x y) (car x) (unbox y) (,e? x y))
`(lambda (x y) (car x) (unbox y) #f))
(test-comp `(lambda (x) (car x) (,e? x (box 0)))
`(lambda (x) (car x) #f))
;Ensure that the reduction doesn't eliminate side effects
(test-comp `(lambda (x) (car x) (,e? (begin (newline) x) (box 0)))
`(lambda (x) (car x) #f)
#f)
(test-comp `(lambda (x) (car x) (,e? x (begin (newline) (box 0))))
`(lambda (x) (car x) #f)
#f)
(test-comp `(lambda () (,e? (box 0) (begin (newline) 7)))
`(lambda () (begin (newline) 7))
#f)
(test-comp `(lambda () (,e? (begin (newline) 7) (box 0)))
`(lambda () (begin (newline) 7))
#f)
(test-comp `(lambda (x) (if (,e? x '(0)) (pair? x) 0))
`(lambda (x) (if (,e? x '(0)) #t 0)))
(test-comp `(lambda (x) (if (,e? x (list 0)) (pair? x) 0))
`(lambda (x) (if (,e? x (list 0)) #t 0)))
(test-comp `(lambda (x y) (car y) (if (,e? x y) (pair? x) 0))
`(lambda (x y) (car y) (if (,e? x y) #t 0))))])
(test-equal? 'eq?)
(test-equal? 'eqv?)
(test-equal? 'equal?))
@ -1616,23 +1641,6 @@
(let ([y (random)])
(begin0 y (set! y 5)))))
(test-comp '(lambda (x y) (car x) (unbox y) #f)
'(lambda (x y) (car x) (unbox y) (eq? x y)))
(test-comp '(lambda (x) (car x) #f)
'(lambda (x) (car x) (eq? x (box 0))))
(test-comp '(lambda (x) (car x) #f)
'(lambda (x) (car x) (eq? (begin (newline) x) (box 0)))
#f)
(test-comp '(lambda (x) (car x) #f)
'(lambda (x) (car x) (eq? x (begin (newline) (box 0))))
#f)
(test-comp '(lambda () (begin (newline) 7))
'(lambda () (eq? (box 0) (begin (newline) 7)))
#f)
(test-comp '(lambda () (begin (newline) 7))
'(lambda () (eq? (begin (newline) 7) (box 0)))
#f)
; It's necessary to use the random from #%kernel because otherwise
; the function will keep an unnecessary reference for the module that
; defines the random visible from racket/base.
@ -2068,12 +2076,6 @@
(test-comp '(lambda (x) (if (null? x) 1 0) null)
'(lambda (x) (if (null? x) 1 0) x)
#f)
(test-comp '(lambda (x) (if (eq? x '(0)) #t 0))
'(lambda (x) (if (eq? x '(0)) (pair? x) 0)))
(test-comp '(lambda (x) (if (eq? x (list 0)) #t 0))
'(lambda (x) (if (eq? x (list 0)) (pair? x) 0)))
(test-comp '(lambda (x y) (car y) (if (eq? x y) #t 0))
'(lambda (x y) (car y) (if (eq? x y) (pair? x) 0)))
(test-comp '(lambda (x) (if x 1 (list #f)))
'(lambda (x) (if x 1 (list x))))

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

@ -4192,13 +4192,29 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
}
}
if ((SAME_OBJ(app->rator, scheme_equal_proc)
if (SAME_OBJ(app->rator, scheme_equal_proc)
|| SAME_OBJ(app->rator, scheme_eqv_proc)
|| SAME_OBJ(app->rator, scheme_eq_proc))
&& equivalent_exprs(app->rand1, app->rand2, NULL, NULL, 0)) {
info->preserves_marks = 1;
info->single_result = 1;
return make_discarding_sequence_3(app->rand1, app->rand2, scheme_true, info);
|| SAME_OBJ(app->rator, scheme_eq_proc)) {
if (equivalent_exprs(app->rand1, app->rand2, NULL, NULL, 0)) {
info->preserves_marks = 1;
info->single_result = 1;
return make_discarding_sequence_3(app->rand1, app->rand2, scheme_true, info);
}
{
Scheme_Object *pred1, *pred2;
pred1 = expr_implies_predicate(app->rand1, info);
if (pred1) {
pred2 = expr_implies_predicate(app->rand2, info);
if (pred2) {
if (predicate_implies_not(pred1, pred2)
|| predicate_implies_not(pred2, pred1)) {
info->preserves_marks = 1;
info->single_result = 1;
return make_discarding_sequence_3(app->rand1, app->rand2, scheme_false, info);
}
}
}
}
}
/* Optimize `equal?' or `eqv?' test on certain types
@ -4219,21 +4235,6 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
}
}
if (SAME_OBJ(app->rator, scheme_eq_proc)) {
Scheme_Object *pred1, *pred2;
pred1 = expr_implies_predicate(app->rand1, info);
if (pred1) {
pred2 = expr_implies_predicate(app->rand2, info);
if (pred2) {
if (predicate_implies_not(pred1, pred2) || predicate_implies_not(pred2, pred1)) {
info->preserves_marks = 1;
info->single_result = 1;
return make_discarding_sequence_3(app->rand1, app->rand2, scheme_false, info);
}
}
}
}
info->preserves_marks = !!(rator_flags & LAMBDA_PRESERVES_MARKS);
info->single_result = !!(rator_flags & LAMBDA_SINGLE_RESULT);
if (rator_flags & LAMBDA_RESULT_TENTATIVE) {
@ -4988,7 +4989,9 @@ static void add_types_for_t_branch(Scheme_Object *t, Optimize_Info *info, int fu
} else if (SAME_TYPE(SCHEME_TYPE(t), scheme_application3_type)) {
Scheme_App3_Rec *app = (Scheme_App3_Rec *)t;
Scheme_Object *pred1, *pred2;
if (SAME_OBJ(app->rator, scheme_eq_proc)) {
if (SAME_OBJ(app->rator, scheme_eq_proc)
|| SAME_OBJ(app->rator, scheme_eqv_proc)
|| SAME_OBJ(app->rator, scheme_equal_proc)) {
if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_ir_local_type)) {
pred1 = expr_implies_predicate(app->rand1, info);
if (!pred1) {