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

fix optimizer for impersonated continuation mark keys

Browse Source 
The optimizer can no longer reduce
  (with-continuation-mark _id _v-expr _expr)
to just
  _expr
when _v-expr and _expr are simple enough, because _id
might be bound to a continuation mark key with an
impersonator that checks the result of _v-expr.

The loss of an optimization can have a significant affect on
errortrace of microbenchmarks, such as

 (for ([i (in-range 10000000)])
   i)
This commit is contained in:
Matthew Flatt 2012-06-26 14:02:25 -06:00
parent db6c2e7737
commit edce1b0406
8 changed files with 87 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/tests/racket/contmark.rktl
View File

@ -954,6 +954,12 @@
(lambda (x) (if (number? x) x (error "fail"))) (lambda (x) (if (number? x) x (error "fail")))
(lambda (x) x))) (lambda (x) x)))
(define cha2-mark
(chaperone-continuation-mark-key
(make-continuation-mark-key)
(lambda (x) x)
(lambda (x) (if (number? x) x (error "fail")))))
(define bad-mark (define bad-mark
(chaperone-continuation-mark-key (chaperone-continuation-mark-key
(make-continuation-mark-key) (make-continuation-mark-key)
@ -970,6 +976,10 @@
(with-continuation-mark mark val (with-continuation-mark mark val
(extract-current-continuation-marks mark))) (extract-current-continuation-marks mark)))
(define (do-test/no-lookup mark val)
(with-continuation-mark mark val
'ok))
(define (do-test* mark val) (define (do-test* mark val)
(with-continuation-mark mark val (with-continuation-mark mark val
(continuation-mark-set->list* (continuation-mark-set->list*
@ -994,6 +1004,8 @@
(wcm-test 5 (lambda () (do-test/first cha-mark 5))) (wcm-test 5 (lambda () (do-test/first cha-mark 5)))
(wcm-test 5 (lambda () (do-test/immediate cha-mark 5))) (wcm-test 5 (lambda () (do-test/immediate cha-mark 5)))
(err/rt-test (do-test cha-mark #t) exn:fail?) (err/rt-test (do-test cha-mark #t) exn:fail?)
(test 'ok do-test/no-lookup cha-mark #t)
(err/rt-test (do-test/no-lookup cha2-mark #t) exn:fail?)
(err/rt-test (do-test bad-mark 5) exn:fail?) (err/rt-test (do-test bad-mark 5) exn:fail?)
(err/rt-test (do-test bad-mark-2 5) exn:fail?)) (err/rt-test (do-test bad-mark-2 5) exn:fail?))

17
collects/tests/racket/contract-test.rktl
View File

@ -4182,15 +4182,14 @@
'continuation-mark-key/c-fo-2 'continuation-mark-key/c-fo-2
'(contract (continuation-mark-key/c string?) 5 'pos 'neg)) '(contract (continuation-mark-key/c string?) 5 'pos 'neg))
;; TODO: Does not pass due to compiler optimization (test/neg-blame
;(test/neg-blame 'continuation-mark-key/c-ho-1
; 'continuation-mark-key/c-ho-1 '(let ([mark (contract (continuation-mark-key/c number?)
; '(let ([mark (contract (continuation-mark-key/c number?) (make-continuation-mark-key)
; (make-continuation-mark-key) 'pos
; 'pos 'neg)])
; 'neg)]) (with-continuation-mark mark "bad"
; (with-continuation-mark mark "bad" 42)))
; 42)))
(test/spec-passed (test/spec-passed
'continuation-mark-key/c-ho-2 'continuation-mark-key/c-ho-2

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

@ -2923,7 +2923,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
total++; total++;
} else if (opt } else if (opt
&& (((opt > 0) && !last) || ((opt < 0) && !first)) && (((opt > 0) && !last) || ((opt < 0) && !first))
&& scheme_omittable_expr(v, -1, -1, 0, NULL, -1)) { && scheme_omittable_expr(v, -1, -1, 0, NULL, -1, 0)) {
/* A value that is not the result. We'll drop it. */ /* A value that is not the result. We'll drop it. */
total++; total++;
} else { } else {
@ -2951,7 +2951,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
/* can't optimize away a begin0 at read time; it's too late, since the /* can't optimize away a begin0 at read time; it's too late, since the
return is combined with EXPD_BEGIN0 */ return is combined with EXPD_BEGIN0 */
addconst = 1; addconst = 1;
} else if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0, NULL, -1)) { } else if ((opt < 0) && !scheme_omittable_expr(SCHEME_CAR(seq), 1, -1, 0, NULL, -1, 0)) {
/* We can't optimize (begin0 expr cont) to expr because /* We can't optimize (begin0 expr cont) to expr because
exp is not in tail position in the original (so we'd mess exp is not in tail position in the original (so we'd mess
up continuation marks). */ up continuation marks). */
@ -2983,7 +2983,7 @@ Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *seq, int opt)
} else if (opt } else if (opt
&& (((opt > 0) && (k < total)) && (((opt > 0) && (k < total))
|| ((opt < 0) && k)) || ((opt < 0) && k))
&& scheme_omittable_expr(v, -1, -1, 0, NULL, -1)) { && scheme_omittable_expr(v, -1, -1, 0, NULL, -1, 0)) {
/* Value not the result. Do nothing. */ /* Value not the result. Do nothing. */
} else } else
o->array[i++] = v; o->array[i++] = v;
@ -3483,7 +3483,7 @@ static Scheme_Object *eval_letmacro_rhs(Scheme_Object *a, Scheme_Comp_Env *rhs_e
save_runstack = scheme_push_prefix(NULL, rp, NULL, NULL, phase, phase, rhs_env->genv, NULL); save_runstack = scheme_push_prefix(NULL, rp, NULL, NULL, phase, phase, rhs_env->genv, NULL);
if (scheme_omittable_expr(a, 1, -1, 0, NULL, -1)) { if (scheme_omittable_expr(a, 1, -1, 0, NULL, -1, 0)) {
/* short cut */ /* short cut */
a = _scheme_eval_linked_expr_multi(a); a = _scheme_eval_linked_expr_multi(a);
} else { } else {

2
src/racket/src/module.c
View File

@ -8694,7 +8694,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
Scheme_Object *prev = NULL, *next; Scheme_Object *prev = NULL, *next;
for (p = first; !SCHEME_NULLP(p); p = next) { for (p = first; !SCHEME_NULLP(p); p = next) {
next = SCHEME_CDR(p); next = SCHEME_CDR(p);
if (scheme_omittable_expr(SCHEME_CAR(p), -1, -1, 0, NULL, -1)) { if (scheme_omittable_expr(SCHEME_CAR(p), -1, -1, 0, NULL, -1, 0)) {
if (prev) if (prev)
SCHEME_CDR(prev) = next; SCHEME_CDR(prev) = next;
else else

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

@ -202,7 +202,7 @@ static void note_match(int actual, int expected, Optimize_Info *warn_info)
} }
int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved, int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
Optimize_Info *warn_info, int deeper_than) Optimize_Info *warn_info, int deeper_than, int no_id)
/* Checks whether the bytecode `o' returns `vals' values with no /* Checks whether the bytecode `o' returns `vals' values with no
side-effects and without pushing and using continuation marks. side-effects and without pushing and using continuation marks.
-1 for vals means that any return count is ok. -1 for vals means that any return count is ok.
@ -220,9 +220,11 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
if ((vtype > _scheme_compiled_values_types_) if ((vtype > _scheme_compiled_values_types_)
|| ((vtype == scheme_local_type) || ((vtype == scheme_local_type)
&& !no_id
&& !(SCHEME_GET_LOCAL_FLAGS(o) == SCHEME_LOCAL_CLEAR_ON_READ) && !(SCHEME_GET_LOCAL_FLAGS(o) == SCHEME_LOCAL_CLEAR_ON_READ)
&& (SCHEME_LOCAL_POS(o) > deeper_than)) && (SCHEME_LOCAL_POS(o) > deeper_than))
|| ((vtype == scheme_local_unbox_type) || ((vtype == scheme_local_unbox_type)
&& !no_id
&& !(SCHEME_GET_LOCAL_FLAGS(o) == SCHEME_LOCAL_CLEAR_ON_READ) && !(SCHEME_GET_LOCAL_FLAGS(o) == SCHEME_LOCAL_CLEAR_ON_READ)
&& (SCHEME_LOCAL_POS(o) > deeper_than)) && (SCHEME_LOCAL_POS(o) > deeper_than))
|| (vtype == scheme_unclosed_procedure_type) || (vtype == scheme_unclosed_procedure_type)
@ -239,7 +241,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
if (vtype == scheme_toplevel_type) { if (vtype == scheme_toplevel_type) {
note_match(1, vals, warn_info); note_match(1, vals, warn_info);
if (resolved && ((vals == 1) || (vals < 0))) { if (!no_id && resolved && ((vals == 1) || (vals < 0))) {
if (SCHEME_TOPLEVEL_FLAGS(o) & SCHEME_TOPLEVEL_FLAGS_MASK) if (SCHEME_TOPLEVEL_FLAGS(o) & SCHEME_TOPLEVEL_FLAGS_MASK)
return 1; return 1;
else else
@ -250,7 +252,9 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
if (vtype == scheme_compiled_toplevel_type) { if (vtype == scheme_compiled_toplevel_type) {
note_match(1, vals, warn_info); note_match(1, vals, warn_info);
if ((vals == 1) || (vals < 0)) { if ((vals == 1) || (vals < 0)) {
if ((SCHEME_TOPLEVEL_FLAGS(o) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_READY) if (!no_id && (SCHEME_TOPLEVEL_FLAGS(o) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_READY)
return 1;
else if ((SCHEME_TOPLEVEL_FLAGS(o) & SCHEME_TOPLEVEL_FLAGS_MASK) >= SCHEME_TOPLEVEL_CONST)
return 1; return 1;
else else
return 0; return 0;
@ -270,9 +274,9 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
if (vtype == scheme_branch_type) { if (vtype == scheme_branch_type) {
Scheme_Branch_Rec *b; Scheme_Branch_Rec *b;
b = (Scheme_Branch_Rec *)o; b = (Scheme_Branch_Rec *)o;
return (scheme_omittable_expr(b->test, 1, fuel - 1, resolved, warn_info, deeper_than) return (scheme_omittable_expr(b->test, 1, fuel - 1, resolved, warn_info, deeper_than, 0)
&& scheme_omittable_expr(b->tbranch, vals, fuel - 1, resolved, warn_info, deeper_than) && scheme_omittable_expr(b->tbranch, vals, fuel - 1, resolved, warn_info, deeper_than, no_id)
&& scheme_omittable_expr(b->fbranch, vals, fuel - 1, resolved, warn_info, deeper_than)); && scheme_omittable_expr(b->fbranch, vals, fuel - 1, resolved, warn_info, deeper_than, no_id));
} }
#if 0 #if 0
@ -280,15 +284,15 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
a let_value_type! */ a let_value_type! */
if (vtype == scheme_let_value_type) { if (vtype == scheme_let_value_type) {
Scheme_Let_Value *lv = (Scheme_Let_Value *)o; Scheme_Let_Value *lv = (Scheme_Let_Value *)o;
return (scheme_omittable_expr(lv->value, lv->count, fuel - 1, resolved, warn_info, deeper_than) return (scheme_omittable_expr(lv->value, lv->count, fuel - 1, resolved, warn_info, deeper_than, no_id)
&& scheme_omittable_expr(lv->body, vals, fuel - 1, resolved, warn_info, deeper_than)); && scheme_omittable_expr(lv->body, vals, fuel - 1, resolved, warn_info, deeper_than, no_id));
} }
#endif #endif
if (vtype == scheme_let_one_type) { if (vtype == scheme_let_one_type) {
Scheme_Let_One *lo = (Scheme_Let_One *)o; Scheme_Let_One *lo = (Scheme_Let_One *)o;
return (scheme_omittable_expr(lo->value, 1, fuel - 1, resolved, warn_info, deeper_than + 1) return (scheme_omittable_expr(lo->value, 1, fuel - 1, resolved, warn_info, deeper_than + 1, 0)
&& scheme_omittable_expr(lo->body, vals, fuel - 1, resolved, warn_info, deeper_than + 1)); && scheme_omittable_expr(lo->body, vals, fuel - 1, resolved, warn_info, deeper_than + 1, no_id));
} }
if (vtype == scheme_let_void_type) { if (vtype == scheme_let_void_type) {
@ -299,7 +303,8 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
if ((lv2->count == 1) if ((lv2->count == 1)
&& (lv2->position == 0) && (lv2->position == 0)
&& scheme_omittable_expr(lv2->value, 1, fuel - 1, resolved, warn_info, && scheme_omittable_expr(lv2->value, 1, fuel - 1, resolved, warn_info,
deeper_than + 1 + lv->count)) { deeper_than + 1 + lv->count,
0)) {
o = lv2->body; o = lv2->body;
deeper_than += 1; deeper_than += 1;
} else } else
@ -316,7 +321,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
if ((lh->count == 1) && (lh->num_clauses == 1)) { if ((lh->count == 1) && (lh->num_clauses == 1)) {
if (SAME_TYPE(SCHEME_TYPE(lh->body), scheme_compiled_let_value_type)) { if (SAME_TYPE(SCHEME_TYPE(lh->body), scheme_compiled_let_value_type)) {
Scheme_Compiled_Let_Value *lv = (Scheme_Compiled_Let_Value *)lh->body; Scheme_Compiled_Let_Value *lv = (Scheme_Compiled_Let_Value *)lh->body;
if (scheme_omittable_expr(lv->value, 1, fuel - 1, resolved, warn_info, deeper_than + 1)) { if (scheme_omittable_expr(lv->value, 1, fuel - 1, resolved, warn_info, deeper_than + 1, 0)) {
o = lv->body; o = lv->body;
deeper_than++; deeper_than++;
goto try_again; goto try_again;
@ -347,7 +352,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
&& (SCHEME_INT_VAL(app->args[4]) >= 0) && (SCHEME_INT_VAL(app->args[4]) >= 0)
&& ((app->num_args < 5) && ((app->num_args < 5)
|| scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved, warn_info, || scheme_omittable_expr(app->args[5], 1, fuel - 1, resolved, warn_info,
deeper_than + (resolved ? app->num_args : 0))) deeper_than + (resolved ? app->num_args : 0), 0))
&& ((app->num_args < 6) && ((app->num_args < 6)
|| SCHEME_NULLP(app->args[6])) || SCHEME_NULLP(app->args[6]))
&& ((app->num_args < 7) && ((app->num_args < 7)
@ -374,7 +379,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
int i; int i;
for (i = app->num_args; i--; ) { for (i = app->num_args; i--; ) {
if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved, warn_info, if (!scheme_omittable_expr(app->args[i + 1], 1, fuel - 1, resolved, warn_info,
deeper_than + (resolved ? app->num_args : 0))) deeper_than + (resolved ? app->num_args : 0), 0))
return 0; return 0;
} }
return 1; return 1;
@ -398,7 +403,7 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
|| ((vals == 1) && !(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT)) || ((vals == 1) && !(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT))
|| ((vals == 1) && SAME_OBJ(scheme_values_func, app->rator)))) { || ((vals == 1) && SAME_OBJ(scheme_values_func, app->rator)))) {
if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved, warn_info, if (scheme_omittable_expr(app->rand, 1, fuel - 1, resolved, warn_info,
deeper_than + (resolved ? 1 : 0))) deeper_than + (resolved ? 1 : 0), 0))
return 1; return 1;
} else if (!(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT) } else if (!(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT)
|| SAME_OBJ(scheme_values_func, app->rator)) { || SAME_OBJ(scheme_values_func, app->rator)) {
@ -418,9 +423,9 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
|| ((vals == 1) && !(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT)) || ((vals == 1) && !(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT))
|| ((vals == 2) && SAME_OBJ(scheme_values_func, app->rator)))) { || ((vals == 2) && SAME_OBJ(scheme_values_func, app->rator)))) {
if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, warn_info, if (scheme_omittable_expr(app->rand1, 1, fuel - 1, resolved, warn_info,
deeper_than + (resolved ? 2 : 0)) deeper_than + (resolved ? 2 : 0), 0)
&& scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved, warn_info, && scheme_omittable_expr(app->rand2, 1, fuel - 1, resolved, warn_info,
deeper_than + (resolved ? 2 : 0))) deeper_than + (resolved ? 2 : 0), 0))
return 1; return 1;
} else if (!(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT)) { } else if (!(SCHEME_PRIM_PROC_FLAGS(app->rator) & SCHEME_PRIM_IS_MULTI_RESULT)) {
note_match(1, vals, warn_info); note_match(1, vals, warn_info);
@ -2043,7 +2048,7 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
if ((SAME_OBJ(scheme_values_func, app->rator) if ((SAME_OBJ(scheme_values_func, app->rator)
|| SAME_OBJ(scheme_list_star_proc, app->rator)) || SAME_OBJ(scheme_list_star_proc, app->rator))
&& (scheme_omittable_expr(app->rand, 1, -1, 0, info, -1) && (scheme_omittable_expr(app->rand, 1, -1, 0, info, -1, 0)
|| single_valued_noncm_expression(app->rand, 5))) { || single_valued_noncm_expression(app->rand, 5))) {
info->preserves_marks = 1; info->preserves_marks = 1;
info->single_result = 1; info->single_result = 1;
@ -2085,13 +2090,13 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
if (SAME_OBJ(scheme_list_proc, app2->rator)) { if (SAME_OBJ(scheme_list_proc, app2->rator)) {
if (IS_NAMED_PRIM(app->rator, "car")) { if (IS_NAMED_PRIM(app->rator, "car")) {
/* (car (list X)) */ /* (car (list X)) */
if (scheme_omittable_expr(app2->rand, 1, 5, 0, NULL, -1) if (scheme_omittable_expr(app2->rand, 1, 5, 0, NULL, -1, 0)
|| single_valued_noncm_expression(app2->rand, 5)) { || single_valued_noncm_expression(app2->rand, 5)) {
alt = app2->rand; alt = app2->rand;
} }
} else if (IS_NAMED_PRIM(app->rator, "cdr")) { } else if (IS_NAMED_PRIM(app->rator, "cdr")) {
/* (cdr (list X)) */ /* (cdr (list X)) */
if (scheme_omittable_expr(app2->rand, 1, 5, 0, NULL, -1)) if (scheme_omittable_expr(app2->rand, 1, 5, 0, NULL, -1, 0))
alt = scheme_null; alt = scheme_null;
} }
} }
@ -2101,28 +2106,28 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz
if (SAME_OBJ(scheme_cons_proc, app3->rator) if (SAME_OBJ(scheme_cons_proc, app3->rator)
|| SAME_OBJ(scheme_list_proc, app3->rator) || SAME_OBJ(scheme_list_proc, app3->rator)
|| SAME_OBJ(scheme_list_star_proc, app3->rator)) { || SAME_OBJ(scheme_list_star_proc, app3->rator)) {
/* (car ({cons|list|cdr} X Y)) */ /* (car ({cons|list|list*} X Y)) */
if ((scheme_omittable_expr(app3->rand1, 1, 5, 0, NULL, -1) if ((scheme_omittable_expr(app3->rand1, 1, 5, 0, NULL, -1, 0)
|| single_valued_noncm_expression(app3->rand1, 5)) || single_valued_noncm_expression(app3->rand1, 5))
&& scheme_omittable_expr(app3->rand2, 1, 5, 0, NULL, -1)) { && scheme_omittable_expr(app3->rand2, 1, 5, 0, NULL, -1, 0)) {
alt = app3->rand1; alt = app3->rand1;
} }
} }
} else if (IS_NAMED_PRIM(app->rator, "cdr")) { } else if (IS_NAMED_PRIM(app->rator, "cdr")) {
/* (car (cons X Y)) */ /* (cdr (cons X Y)) */
if (SAME_OBJ(scheme_cons_proc, app3->rator)) { if (SAME_OBJ(scheme_cons_proc, app3->rator)) {
if ((scheme_omittable_expr(app3->rand2, 1, 5, 0, NULL, -1) if ((scheme_omittable_expr(app3->rand2, 1, 5, 0, NULL, -1, 0)
|| single_valued_noncm_expression(app3->rand2, 5)) || single_valued_noncm_expression(app3->rand2, 5))
&& scheme_omittable_expr(app3->rand1, 1, 5, 0, NULL, -1)) { && scheme_omittable_expr(app3->rand1, 1, 5, 0, NULL, -1, 0)) {
alt = app3->rand2; alt = app3->rand2;
} }
} }
} else if (IS_NAMED_PRIM(app->rator, "cadr")) { } else if (IS_NAMED_PRIM(app->rator, "cadr")) {
if (SAME_OBJ(scheme_list_proc, app3->rator)) { if (SAME_OBJ(scheme_list_proc, app3->rator)) {
/* (cadr (list X Y)) */ /* (cadr (list X Y)) */
if ((scheme_omittable_expr(app3->rand2, 1, 5, 0, NULL, -1) if ((scheme_omittable_expr(app3->rand2, 1, 5, 0, NULL, -1, 0)
|| single_valued_noncm_expression(app3->rand2, 5)) || single_valued_noncm_expression(app3->rand2, 5))
&& scheme_omittable_expr(app3->rand1, 1, 5, 0, NULL, -1)) { && scheme_omittable_expr(app3->rand1, 1, 5, 0, NULL, -1, 0)) {
alt = app3->rand2; alt = app3->rand2;
} }
} }
@ -2474,7 +2479,7 @@ static Scheme_Object *optimize_sequence(Scheme_Object *o, Optimize_Info *info, i
/* Inlining and constant propagation can expose /* Inlining and constant propagation can expose
omittable expressions. */ omittable expressions. */
if ((i + 1 != count) if ((i + 1 != count)
&& scheme_omittable_expr(le, -1, -1, 0, NULL, -1)) { && scheme_omittable_expr(le, -1, -1, 0, NULL, -1, 0)) {
drop++; drop++;
info->size = prev_size; info->size = prev_size;
s->array[i] = NULL; s->array[i] = NULL;
@ -2657,7 +2662,7 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
} }
/* Try optimize: (if <omitable-expr> v v) => v */ /* Try optimize: (if <omitable-expr> v v) => v */
if (scheme_omittable_expr(t, 1, 20, 0, NULL, -1) if (scheme_omittable_expr(t, 1, 20, 0, NULL, -1, 0)
&& equivalent_exprs(tb, fb)) { && equivalent_exprs(tb, fb)) {
info->size -= 2; /* could be more precise */ info->size -= 2; /* could be more precise */
return tb; return tb;
@ -2695,6 +2700,13 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info, int
return o; return o;
} }
static int omittable_key(Scheme_Object *k, Optimize_Info *info)
{
/* A key is not omittable if it might refer to a chaperoned/impersonated
continuation mark key, so that's why we pass 1 for `no_id': */
return scheme_omittable_expr(k, 1, 20, 0, info, -1, 1);
}
static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int context) static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int context)
{ {
Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)o; Scheme_With_Continuation_Mark *wcm = (Scheme_With_Continuation_Mark *)o;
@ -2706,9 +2718,9 @@ static Scheme_Object *optimize_wcm(Scheme_Object *o, Optimize_Info *info, int co
b = scheme_optimize_expr(wcm->body, info, scheme_optimize_tail_context(context)); b = scheme_optimize_expr(wcm->body, info, scheme_optimize_tail_context(context));
if (scheme_omittable_expr(k, 1, 20, 0, info, -1) if (omittable_key(k, info)
&& scheme_omittable_expr(v, 1, 20, 0, info, -1) && scheme_omittable_expr(v, 1, 20, 0, info, -1, 0)
&& scheme_omittable_expr(b, -1, 20, 0, info, -1)) && scheme_omittable_expr(b, -1, 20, 0, info, -1, 0))
return b; return b;
/* info->single_result is already set */ /* info->single_result is already set */
@ -3249,7 +3261,7 @@ int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info)
Scheme_Let_Header *lh = (Scheme_Let_Header *)value; Scheme_Let_Header *lh = (Scheme_Let_Header *)value;
if (lh->num_clauses == 1) { if (lh->num_clauses == 1) {
Scheme_Compiled_Let_Value *lv = (Scheme_Compiled_Let_Value *)lh->body; Scheme_Compiled_Let_Value *lv = (Scheme_Compiled_Let_Value *)lh->body;
if (scheme_omittable_expr(lv->value, lv->count, 20, 0, NULL, -1)) { if (scheme_omittable_expr(lv->value, lv->count, 20, 0, NULL, -1, 0)) {
value = lv->body; value = lv->body;
info = NULL; info = NULL;
} else } else
@ -3801,7 +3813,8 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
&& scheme_omittable_expr(value, pre_body->count, -1, 0, info, && scheme_omittable_expr(value, pre_body->count, -1, 0, info,
(is_rec (is_rec
? (pre_body->position + pre_body->count) ? (pre_body->position + pre_body->count)
: -1))) { : -1),
0)) {
if (!pre_body->count && !i) { if (!pre_body->count && !i) {
/* We want to drop the clause entirely, but doing it /* We want to drop the clause entirely, but doing it
here messes up the loop for letrec. So wait and here messes up the loop for letrec. So wait and
@ -4180,7 +4193,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline, i
} }
if (!used if (!used
&& (scheme_omittable_expr(pre_body->value, pre_body->count, -1, 0, info, -1) && (scheme_omittable_expr(pre_body->value, pre_body->count, -1, 0, info, -1, 0)
|| ((pre_body->count == 1) || ((pre_body->count == 1)
&& first_once_used && first_once_used
&& (first_once_used->pos == pos) && (first_once_used->pos == pos)
@ -4616,7 +4629,7 @@ static int is_general_compiled_proc(Scheme_Object *e)
if (seq->count > 0) { if (seq->count > 0) {
int i; int i;
for (i = seq->count - 1; i--; ) { for (i = seq->count - 1; i--; ) {
if (!scheme_omittable_expr(seq->array[i], -1, 20, 0, NULL, -1)) if (!scheme_omittable_expr(seq->array[i], -1, 20, 0, NULL, -1, 0))
return 0; return 0;
} }
} }
@ -4749,7 +4762,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
e = SCHEME_VEC_ELS(e)[1]; e = SCHEME_VEC_ELS(e)[1];
n = scheme_list_length(vars); n = scheme_list_length(vars);
cont = scheme_omittable_expr(e, n, -1, 0, info, -1); cont = scheme_omittable_expr(e, n, -1, 0, info, -1, 0);
if (n == 1) { if (n == 1) {
if (scheme_compiled_propagate_ok(e, info)) if (scheme_compiled_propagate_ok(e, info))
@ -4827,7 +4840,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
} }
} }
} else { } else {
cont = scheme_omittable_expr(e, -1, -1, 0, NULL, -1); cont = scheme_omittable_expr(e, -1, -1, 0, NULL, -1, 0);
} }
if (i_m + 1 == cnt) if (i_m + 1 == cnt)
cont = 0; cont = 0;
@ -5001,7 +5014,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */ /* Optimize this expression: */
e = SCHEME_VEC_ELS(m->bodies[0])[i_m]; e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
if (scheme_omittable_expr(e, -1, -1, 0, NULL, -1)) { if (scheme_omittable_expr(e, -1, -1, 0, NULL, -1, 0)) {
can_omit++; can_omit++;
} }
} }
@ -5012,7 +5025,7 @@ module_optimize(Scheme_Object *data, Optimize_Info *info, int context)
for (i_m = 0; i_m < cnt; i_m++) { for (i_m = 0; i_m < cnt; i_m++) {
/* Optimize this expression: */ /* Optimize this expression: */
e = SCHEME_VEC_ELS(m->bodies[0])[i_m]; e = SCHEME_VEC_ELS(m->bodies[0])[i_m];
if (!scheme_omittable_expr(e, -1, -1, 0, NULL, -1)) { if (!scheme_omittable_expr(e, -1, -1, 0, NULL, -1, 0)) {
SCHEME_VEC_ELS(vec)[j++] = e; SCHEME_VEC_ELS(vec)[j++] = e;
} }
} }

4
src/racket/src/resolve.c
View File

@ -508,7 +508,7 @@ static Scheme_Object *look_for_letv_change(Scheme_Sequence *s)
v = s->array[i]; v = s->array[i];
if (SAME_TYPE(SCHEME_TYPE(v), scheme_let_value_type)) { if (SAME_TYPE(SCHEME_TYPE(v), scheme_let_value_type)) {
Scheme_Let_Value *lv = (Scheme_Let_Value *)v; Scheme_Let_Value *lv = (Scheme_Let_Value *)v;
if (scheme_omittable_expr(lv->body, 1, -1, 0, NULL, -1)) { if (scheme_omittable_expr(lv->body, 1, -1, 0, NULL, -1, 0)) {
int esize = s->count - (i + 1); int esize = s->count - (i + 1);
int nsize = i + 1; int nsize = i + 1;
Scheme_Object *nv, *ev; Scheme_Object *nv, *ev;
@ -1229,7 +1229,7 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
} }
if (j >= 0) if (j >= 0)
break; break;
if (!scheme_omittable_expr(clv->value, clv->count, -1, 0, NULL, -1)) if (!scheme_omittable_expr(clv->value, clv->count, -1, 0, NULL, -1, 0))
break; break;
} }
if (i < 0) { if (i < 0) {

9
src/racket/src/schpriv.h
View File

@ -1284,11 +1284,12 @@ typedef struct Scheme_Toplevel {
/* The MASK pull out one of the levels for reference (CONST, /* The MASK pull out one of the levels for reference (CONST,
FIXED, READY, or UNKNOWN) or one of the two levels for a FIXED, READY, or UNKNOWN) or one of the two levels for a
reference (SEAL or not) */ definition (SEAL or not) */
#define SCHEME_TOPLEVEL_FLAGS_MASK 0x3 #define SCHEME_TOPLEVEL_FLAGS_MASK 0x3
/* CONST means that a toplevel is READY and always has the same value, /* CONST means that a toplevel is READY and always has the "same" value,
even for different instantiations or phases. */ even for different instantiations or phases. "Same" means that the result
is a procedure or would be ok to duplicate in the source. */
#define SCHEME_TOPLEVEL_CONST 3 #define SCHEME_TOPLEVEL_CONST 3
/* FIXED is READY plus a promise of no mutation, but the value is /* FIXED is READY plus a promise of no mutation, but the value is
not necessarily constant across different instantations or phases. */ not necessarily constant across different instantations or phases. */
@ -2863,7 +2864,7 @@ int scheme_used_app_only(Scheme_Comp_Env *env, int which);
int scheme_used_ever(Scheme_Comp_Env *env, int which); int scheme_used_ever(Scheme_Comp_Env *env, int which);
int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved, int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
Optimize_Info *warn_info, int deeper_than); Optimize_Info *warn_info, int deeper_than, int no_id);
int scheme_might_invoke_call_cc(Scheme_Object *value); int scheme_might_invoke_call_cc(Scheme_Object *value);
int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator); int scheme_is_liftable(Scheme_Object *o, int bind_count, int fuel, int as_rator);

2
src/racket/src/sfs.c
View File

@ -671,7 +671,7 @@ static Scheme_Object *sfs_let_one(Scheme_Object *o, SFS_Info *info)
it might not because (1) it was introduced late by inlining, it might not because (1) it was introduced late by inlining,
or (2) the rhs expression doesn't always produce a single or (2) the rhs expression doesn't always produce a single
value. */ value. */
if (scheme_omittable_expr(rhs, 1, -1, 1, NULL, -1)) { if (scheme_omittable_expr(rhs, 1, -1, 1, NULL, -1, 0)) {
rhs = scheme_false; rhs = scheme_false;
} else if ((ip < info->max_calls[pos]) } else if ((ip < info->max_calls[pos])
&& SAME_TYPE(SCHEME_TYPE(rhs), scheme_toplevel_type)) { && SAME_TYPE(SCHEME_TYPE(rhs), scheme_toplevel_type)) {