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

Mark (values <expr>) as single valued

Browse Source 
While reducing some ignored constructors, the optimizer may wrap the arguments
<expr> in (values <expr>) to ensure that it's a single value non-cm expression.
This avoids the unnecessary nesting of (values (values <expr>)).

Similarly, add the cases for begin and begin0 to single_valued_noncm_expression
This commit is contained in:
Gustavo Massaccesi 2015-07-11 12:33:35 -03:00
parent d0c9a894fb
commit b7ae673ee0
2 changed files with 38 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1563,6 +1563,17 @@
(test-comp '(lambda (w) (if (void (list w)) 1 2))
'(lambda (w) 1))
; Diferent number of argumets use different codepaths
(test-comp '(lambda (f x) (void))
'(lambda (f x) (void (list))))
(test-comp '(lambda (f x) (begin (values (f x)) (void)))
'(lambda (f x) (void (list (f x)))))
(test-comp '(lambda (f x) (begin (values (f x)) (values (f x)) (void)))
'(lambda (f x) (void (list (f x) (f x)))))
(test-comp '(lambda (f x) (begin (values (f x)) (values (f x)) (values (f x)) (void)))
'(lambda (f x) (void (list (f x) (f x) (f x)))))
(test null
call-with-values (lambda () (with-continuation-mark 'a 'b (values))) list)

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

@ -1212,10 +1212,11 @@ Scheme_Object *scheme_make_struct_proc_shape(intptr_t k)
}
static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
/* Not necessarily omittable or copyable, but single-valued expresions that are not sensitive
/* Not necessarily omittable or copyable, but single-valued expressions that are not sensitive
to being in tail position. */
{
Scheme_Object *rator = NULL;
int num_args = 0;
switch (SCHEME_TYPE(expr)) {
case scheme_local_type:
@ -1224,31 +1225,29 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
return 1;
case scheme_application_type:
rator = ((Scheme_App_Rec *)expr)->args[0];
num_args = ((Scheme_App_Rec *)expr)->num_args;
break;
case scheme_application2_type:
rator = ((Scheme_App2_Rec *)expr)->rator;
num_args = 1;
break;
case scheme_application3_type:
rator = ((Scheme_App2_Rec *)expr)->rator;
break;
case scheme_compiled_let_void_type:
{
Scheme_Let_Header *lh = (Scheme_Let_Header *)expr;
Scheme_Compiled_Let_Value *clv;
if ((lh->count == 1) && (lh->num_clauses == 1) && (fuel > 0)) {
clv = (Scheme_Compiled_Let_Value *)lh->body;
return single_valued_noncm_expression(clv->body, fuel - 1);
}
}
num_args = 2;
break;
case scheme_branch_type:
if (fuel > 0) {
Scheme_Branch_Rec *b = (Scheme_Branch_Rec *)expr;
return (single_valued_noncm_expression(b->test, fuel - 1)
&& single_valued_noncm_expression(b->tbranch, fuel - 1)
return (single_valued_noncm_expression(b->tbranch, fuel - 1)
&& single_valued_noncm_expression(b->fbranch, fuel - 1));
}
break;
case scheme_begin0_sequence_type:
if (fuel > 0) {
Scheme_Sequence *seq = (Scheme_Sequence *)expr;
return single_valued_noncm_expression(seq->array[0], fuel - 1);
}
break;
case scheme_compiled_unclosed_procedure_type:
case scheme_case_lambda_sequence_type:
case scheme_set_bang_type:
@ -1256,6 +1255,17 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
default:
if (SCHEME_TYPE(expr) > _scheme_compiled_values_types_)
return 1;
/* for scheme_compiled_let_void_type
and scheme_begin_sequence_type */
if (fuel > 0) {
int offset = 0;
Scheme_Object *tail = expr, *inside = NULL;
extract_tail_inside(&tail, &inside, &offset);
if (inside)
return single_valued_noncm_expression(tail, fuel - 1);
}
break;
}
@ -1264,6 +1274,10 @@ static int single_valued_noncm_expression(Scheme_Object *expr, int fuel)
opt = ((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_OPT_MASK;
if (opt >= SCHEME_PRIM_OPT_NONCM)
return 1;
/* special case: (values <expr>) */
if (SAME_OBJ(rator, scheme_values_func) && (num_args == 1))
return 1;
}
return 0;