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

optimizer: fix reordering problems

Browse Source 
When a variable X is bound to an expression that implies properties of
other bindings, and if X is used only once and can be replaced by
its value expression, then further optimization of that expression must
not assume the properties that are established by evaluating the
expression.

Also, don't move expressions past unsafe operations, since the expression
might implicitly guard against unsafety.

Closes PR 14819
This commit is contained in:
Matthew Flatt 2014-11-02 19:15:07 -07:00
parent 0d6deb84de
commit 9a94366c2c
2 changed files with 63 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
pkgs/racket-pkgs/racket-test/tests/racket/optimize.rktl
View File

@ -1741,18 +1741,45 @@
(test 2 values v)))
(test-comp '(lambda (z)
;; ok to reorder `(list z)` and `(list (z 2))`,
;; which then allows more simplication:
(let-values ([(a b) (values (list z) (list (z 2)))])
(list a b)))
;; Moving `(list z)` before `(list (z 2))`
;; would reorder, which is not allowed, so check
;; that the optimizer can keep track:
(let-values ([(a b) (values (list z) (list (z 2)))])
(list a b)))
'(lambda (z)
(list (list z) (list (z 2)))))
(test-comp '(lambda (z)
(let-values ([(a b) (values (list (z 2)) (list z))])
(list a b)))
'(lambda (z)
(let ([p (list z)])
(list (list (z 2)) p))))
(list (list (z 2)) (list z))))
#;
(test-comp '(lambda (z)
;; It's ok to reorder unsafe operations relative
;; to each other:
(let ([x (unsafe-fx+ z z)]
[y (unsafe-fx- z z)])
(- y x)))
'(lambda (z)
(- (unsafe-fx- z z) (unsafe-fx+ z z))))
(test-comp '(lambda (z)
;; It's not ok to move a safe operation past an
;; unsafe one:
(let ([x (car z)])
(+ (unsafe-car z) x)))
'(lambda (z)
(+ (unsafe-car z) (car z)))
#f)
(test-comp '(lambda (z)
;; It's ok to move an unsafe operation past a
;; safe one:
(let ([x (unsafe-car void)])
(+ (car z) x)))
'(lambda (z)
(+ (car z) (unsafe-car void))))
(test-comp '(lambda (z)
(let-values ([(x y)
@ -4197,6 +4224,18 @@
(test 1 dynamic-require ''module-with-cross-module-inlining 'n)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that moving `(car x)` doesn't assume
;; the pairness invariant established by `(car x)`.
(define (f x)
(define (g x)
(let* ([z (random)]
[y (car x)])
(+ (random y) z)))
(g x))
(err/rt-test (f 10))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@ -83,6 +83,7 @@ struct Optimize_Info
Scheme_Object *context; /* for logging */
Scheme_Logger *logger;
Scheme_Hash_Tree *types; /* maps position (from this frame) to predicate */
int no_types;
};
typedef struct Optimize_Info_Sequence {
@ -2159,7 +2160,7 @@ static Scheme_Object *check_app_let_rator(Scheme_Object *app, Scheme_Object *rat
static int is_nonmutating_primitive(Scheme_Object *rator, int n)
{
if (SCHEME_PRIMP(rator)
&& (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE | SCHEME_PRIM_IS_UNSAFE_NONMUTATING))
&& (SCHEME_PRIM_PROC_OPT_FLAGS(rator) & (SCHEME_PRIM_IS_OMITABLE))
&& (n >= ((Scheme_Primitive_Proc *)rator)->mina)
&& (n <= ((Scheme_Primitive_Proc *)rator)->mu.maxa))
return 1;
@ -6844,10 +6845,22 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info, in
0, 5)) {
val = optimize_clone(1, o->expr, info, o->delta, 0);
if (val) {
int save_fuel = info->inline_fuel, save_no_types = info->no_types;
int save_vclock, save_kclock;
info->size -= 1;
o->used = 1;
info->inline_fuel = 0; /* no more inlining; o->expr was already optimized */
return scheme_optimize_expr(val, info, context);
info->no_types = 1; /* cannot used inferred types, in case `val' inferred them */
save_vclock = info->vclock; /* allowed to move => no change to clocks */
save_kclock = info->kclock;
val = scheme_optimize_expr(val, info, context);
info->inline_fuel = save_fuel;
info->no_types = save_no_types;
info->vclock = save_vclock;
info->kclock = save_kclock;
return val;
}
}
/* Can't move expression, so lookup again to mark as used
@ -7976,6 +7989,8 @@ Scheme_Object *optimize_get_predicate(int pos, Optimize_Info *info)
{
Scheme_Object *pred;
if (info->no_types) return NULL;
while (info) {
if (info->types) {
pred = scheme_hash_tree_get(info->types, scheme_make_integer(pos));
@ -8011,6 +8026,7 @@ static Optimize_Info *optimize_info_add_frame(Optimize_Info *info, int orig, int
naya->init_kclock = info->kclock;
naya->use_psize = info->use_psize;
naya->logger = info->logger;
naya->no_types = info->no_types;
return naya;
}