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

Intersect types gathered in if branches

Browse Source
This commit is contained in:
Gustavo Massaccesi 2015-05-13 19:38:52 -03:00
parent ea016bec96
commit 1a091f535e
2 changed files with 88 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1369,17 +1369,55 @@
(list l l))))
(test-comp '(lambda (w z)
(list (if (pair? w)
(car z)
(car w))
(list (if (pair? w) (car w) (car z))
(cdr w)))
'(lambda (w z)
(list (if (pair? w)
(car z)
(car w))
(list (if (pair? w) (car w) (car z))
(unsafe-cdr w)))
#f)
(test-comp '(lambda (w z)
(list (if z (car z) (car w))
(cdr w)))
'(lambda (w z)
(list (if z (car z) (car w))
(unsafe-cdr w)))
#f)
(test-comp '(lambda (w z)
(list (if (pair? w) (car z) (car w))
(cdr w)))
'(lambda (w z)
(list (if (pair? w) (car z) (car w))
(unsafe-cdr w))))
(test-comp '(lambda (w z)
(list (if z (car w) (cdr w))
(cdr w)))
'(lambda (w z)
(list (if z (car w) (cdr w))
(unsafe-cdr w))))
(test-comp '(lambda (w z x)
(list (car x) (if z (car w) (cdr w)) (car x)))
'(lambda (w z x)
(list (car x) (if z (car w) (cdr w)) (unsafe-car x))))
(test-comp '(lambda (w z x)
(list (car x) (if z (car w) 2) (car x)))
'(lambda (w z x)
(list (car x) (if z (car w) 2) (unsafe-car x))))
(test-comp '(lambda (w z x)
(list (car x) (if z 1 (cdr w)) (car x)))
'(lambda (w z x)
(list (car x) (if z 1 (cdr w)) (unsafe-car x))))
(test-comp '(lambda (w z x)
(list (car x) (if z 1 2) (car x)))
'(lambda (w z x)
(list (car x) (if z 1 2) (unsafe-car x))))
(test-comp '(lambda (w)
(list
(car (begin (random) w))
@ -4603,7 +4641,7 @@
(read (open-input-bytes (get-output-bytes o))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that an unsufe opertion's argument is
;; Check that an unsafe opertion's argument is
;; not "optimized" away if it's a use of
;; a variable before definition:

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

@ -3930,6 +3930,47 @@ static void merge_types(Optimize_Info *src_info, Optimize_Info *info, int delta)
}
}
Scheme_Hash_Tree *intersect_and_merge_types(Scheme_Hash_Tree *t_types, Scheme_Hash_Tree *f_types,
Scheme_Hash_Tree *base_types)
/* return (union (intersetion t_type f_types) base_types)
in case a key is already in base_type, the value is not modified*/
{
Scheme_Object *pos, *t_pred, *f_pred, *base_pred;
intptr_t i;
if (!t_types || !f_types)
return base_types;
if (base_types && (SAME_OBJ(f_types, base_types) || SAME_OBJ(t_types, base_types)))
return base_types;
if (f_types->count > t_types->count) {
Scheme_Object *swap = f_types;
f_types = t_types;
t_types = swap;
}
i = scheme_hash_tree_next(f_types, -1);
while (i != -1) {
scheme_hash_tree_index(f_types, i, &pos, &f_pred);
t_pred = scheme_hash_tree_get(t_types, pos);
if (t_pred && SAME_OBJ(t_pred, f_pred)) {
if (base_types)
base_pred = scheme_hash_tree_get(base_types, pos);
else
base_pred = NULL;
if (!base_pred) {
if (!base_types)
base_types = scheme_make_hash_tree(0);
base_types = scheme_hash_tree_set(base_types, pos, f_pred);
}
}
i = scheme_hash_tree_next(f_types, i);
}
return base_types;
}
static int relevant_predicate(Scheme_Object *pred)
{
/* Relevant predicates need to be disjoint for try_reduce_predicate(),
@ -4151,7 +4192,8 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
info->single_result = then_single_result;
if (then_kclock > info->kclock)
info->kclock = then_kclock;
info->types = init_types; /* could try to take an intersection here ... */
init_types = intersect_and_merge_types(then_types, info->types, init_types);
info->types = init_types;
}
if (then_sclock > info->sclock)