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

Infer type from comparisons in test positions

Browse Source 
In (if (eq? x <pred?-expr>) <tbranch> <fbranch>) infer that the type of
x is pred? in the tbranch.

Also, reduce (eq? x y) => #f when the types are different.
This commit is contained in:
Gustavo Massaccesi 2015-06-28 14:57:54 -03:00
parent bc2cf531e3
commit dfc64053b7
2 changed files with 52 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1485,6 +1485,11 @@
(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 (w) (car w) (mcar w))
'(lambda (w) (car w) (mcar w) (random)))
(test-comp '(lambda (w) (car w w))
@ -1762,6 +1767,13 @@
(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) (let ([r (something)])
(r)))

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

@ -3553,6 +3553,21 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz
}
}
if (SAME_OBJ(app->rator, scheme_eq_prim)) {
Scheme_Object *pred1, *pred2;
pred1 = expr_implies_predicate(app->rand1, info, 0, 5);
if (pred1) {
pred2 = expr_implies_predicate(app->rand2, info, 0, 5);
if (pred2) {
if (!SAME_OBJ(pred1, pred2)) {
info->preserves_marks = 1;
info->single_result = 1;
return scheme_false;
}
}
}
}
info->preserves_marks = !!(rator_flags & CLOS_PRESERVES_MARKS);
info->single_result = !!(rator_flags & CLOS_SINGLE_RESULT);
if (rator_flags & CLOS_RESULT_TENTATIVE) {
@ -4041,6 +4056,31 @@ static void add_types(Scheme_Object *t, Optimize_Info *info, int fuel)
operations to unsafe operations. */
add_type(info, SCHEME_LOCAL_POS(app->rand), app->rator);
}
} 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_prim)) {
if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_local_type)
&& !optimize_is_mutated(info, SCHEME_LOCAL_POS(app->rand1))) {
pred1 = optimize_get_predicate(SCHEME_LOCAL_POS(app->rand1), info);
if (!pred1) {
pred2 = expr_implies_predicate(app->rand2, info, 0, 5);
if (pred2)
add_type(info, SCHEME_LOCAL_POS(app->rand1), pred2);
}
}
if (SAME_TYPE(SCHEME_TYPE(app->rand2), scheme_local_type)
&& !optimize_is_mutated(info, SCHEME_LOCAL_POS(app->rand2))) {
pred2 = optimize_get_predicate(SCHEME_LOCAL_POS(app->rand2), info);
if (!pred2) {
pred1 = expr_implies_predicate(app->rand1, info, 0, 5);
if (pred1)
add_type(info, SCHEME_LOCAL_POS(app->rand2), pred1);
}
}
}
} else if (SAME_TYPE(SCHEME_TYPE(t), scheme_branch_type)) {
Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)t;
if (SCHEME_FALSEP(b->fbranch)) {