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

make compiler slightly smarter about 0-value letrec-values bindings

Browse Source 
which corresponds to code generated from experession that are
 mixed with internal definitions
This commit is contained in:
Matthew Flatt 2010-07-07 12:39:23 -06:00
parent 54216b5ced
commit 519d1ef8d1
2 changed files with 102 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/scribblings/guide/performance.scrbl
View File

@ -228,10 +228,11 @@ In the first case, the compiler likely does not know that
available. available.
This caveat about @racket[letrec] also applies to definitions of This caveat about @racket[letrec] also applies to definitions of
functions and constants within modules. A definition sequence in a functions and constants as internal definitions or in modules. A
module body is analogous to a sequence of @racket[letrec] bindings, definition sequence in a module body is analogous to a sequence of
and non-constant expressions in a module body can interfere with the @racket[letrec] bindings, and non-constant expressions in a module
optimization of references to later bindings. body can interfere with the optimization of references to later
bindings.
@; ---------------------------------------------------------------------- @; ----------------------------------------------------------------------

137
src/racket/src/syntax.c
View File

@ -3707,6 +3707,23 @@ static int get_convert_arg_count(Scheme_Object *lift)
return 0; return 0;
} }
static Scheme_Object *drop_zero_value_return(Scheme_Object *expr)
{
if (SAME_TYPE(SCHEME_TYPE(expr), scheme_sequence_type)) {
if (((Scheme_Sequence *)expr)->count == 2) {
if (SAME_TYPE(SCHEME_TYPE(((Scheme_Sequence *)expr)->array[1]), scheme_application_type)) {
if (((Scheme_App_Rec *)((Scheme_Sequence *)expr)->array[1])->num_args == 0) {
if (SAME_OBJ(scheme_values_func, ((Scheme_App_Rec *)((Scheme_Sequence *)expr)->array[1])->args[0])) {
return ((Scheme_Sequence *)expr)->array[0];
}
}
}
}
}
return NULL;
}
Scheme_Object * Scheme_Object *
scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info) scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
{ {
@ -3714,7 +3731,7 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
Scheme_Let_Header *head = (Scheme_Let_Header *)form; Scheme_Let_Header *head = (Scheme_Let_Header *)form;
Scheme_Compiled_Let_Value *clv, *pre_body; Scheme_Compiled_Let_Value *clv, *pre_body;
Scheme_Let_Value *lv, *last = NULL; Scheme_Let_Value *lv, *last = NULL;
Scheme_Object *first = NULL, *body, *last_body = NULL; Scheme_Object *first = NULL, *body, *last_body = NULL, *last_seq = NULL;
Scheme_Letrec *letrec; Scheme_Letrec *letrec;
mzshort *skips, skips_fast[5]; mzshort *skips, skips_fast[5];
char *flonums, flonums_fast[5]; char *flonums, flonums_fast[5];
@ -4215,49 +4232,83 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
int j; int j;
Scheme_Object *one_lifted; Scheme_Object *one_lifted;
expr = scheme_resolve_expr(clv->value, val_linfo); if (!clv->count)
expr = drop_zero_value_return(clv->value);
lv = MALLOC_ONE_TAGGED(Scheme_Let_Value);
if (last)
last->body = (Scheme_Object *)lv;
else if (last_body)
SCHEME_CDR(last_body) = (Scheme_Object *)lv;
else else
first = (Scheme_Object *)lv; expr = NULL;
last = lv;
last_body = NULL;
lv->iso.so.type = scheme_let_value_type; if (expr) {
lv->value = expr; /* changing a [() (begin expr (values))] clause,
if (clv->count) { which can be generated by internal-definition expansion,
int li; into a `begin' */
li = scheme_resolve_info_lookup(linfo, clv->position, NULL, NULL, 0); expr = scheme_resolve_expr(expr, val_linfo);
lv->position = li; expr = scheme_make_sequence_compilation(scheme_make_pair(expr,
} else scheme_make_pair(scheme_false,
lv->position = 0; scheme_null)),
lv->count = clv->count; 0);
SCHEME_LET_AUTOBOX(lv) = recbox;
for (j = lv->count; j--; ) { if (last)
if (!recbox last->body = expr;
&& (scheme_resolve_info_flags(linfo, opos + j, &one_lifted) & SCHEME_INFO_BOXED)) { else if (last_body)
GC_CAN_IGNORE Scheme_Object *pos; SCHEME_CDR(last_body) = expr;
pos = scheme_make_integer(lv->position + j); else if (last_seq)
if (SCHEME_LET_FLAGS(head) & (SCHEME_LET_STAR | SCHEME_LET_RECURSIVE)) { ((Scheme_Sequence *)last_seq)->array[1] = expr;
/* For let* or a let*-like letrec, we need to insert the boxes after each evaluation. */ else
Scheme_Object *boxenv, *pr; first = expr;
pr = scheme_make_pair(pos, scheme_false); last = NULL;
boxenv = scheme_make_syntax_resolved(BOXENV_EXPD, pr); last_body = NULL;
if (last) last_seq = expr;
last->body = boxenv; } else {
else expr = scheme_resolve_expr(clv->value, val_linfo);
SCHEME_CDR(last_body) = boxenv;
last = NULL; lv = MALLOC_ONE_TAGGED(Scheme_Let_Value);
last_body = pr; if (last)
} else { last->body = (Scheme_Object *)lv;
/* For regular let, delay the boxing until all RHSs are else if (last_body)
evaluated. */ SCHEME_CDR(last_body) = (Scheme_Object *)lv;
boxes = scheme_make_pair(pos, boxes); else if (last_seq)
((Scheme_Sequence *)last_seq)->array[1] = (Scheme_Object *)lv;
else
first = (Scheme_Object *)lv;
last = lv;
last_body = NULL;
last_seq = NULL;
lv->iso.so.type = scheme_let_value_type;
lv->value = expr;
if (clv->count) {
int li;
li = scheme_resolve_info_lookup(linfo, clv->position, NULL, NULL, 0);
lv->position = li;
} else
lv->position = 0;
lv->count = clv->count;
SCHEME_LET_AUTOBOX(lv) = recbox;
for (j = lv->count; j--; ) {
if (!recbox
&& (scheme_resolve_info_flags(linfo, opos + j, &one_lifted) & SCHEME_INFO_BOXED)) {
GC_CAN_IGNORE Scheme_Object *pos;
pos = scheme_make_integer(lv->position + j);
if (SCHEME_LET_FLAGS(head) & (SCHEME_LET_STAR | SCHEME_LET_RECURSIVE)) {
/* For let* or a let*-like letrec, we need to insert the boxes after each evaluation. */
Scheme_Object *boxenv, *pr;
pr = scheme_make_pair(pos, scheme_false);
boxenv = scheme_make_syntax_resolved(BOXENV_EXPD, pr);
if (last)
last->body = boxenv;
else if (last_seq)
((Scheme_Sequence *)last_seq)->array[1] = boxenv;
else
SCHEME_CDR(last_body) = boxenv;
last = NULL;
last_body = pr;
last_seq = NULL;
} else {
/* For regular let, delay the boxing until all RHSs are
evaluated. */
boxes = scheme_make_pair(pos, boxes);
}
} }
} }
} }
@ -4283,12 +4334,16 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
last->body = (Scheme_Object *)letrec; last->body = (Scheme_Object *)letrec;
else if (last_body) else if (last_body)
SCHEME_CDR(last_body) = (Scheme_Object *)letrec; SCHEME_CDR(last_body) = (Scheme_Object *)letrec;
else if (last_seq)
((Scheme_Sequence *)last_seq)->array[1] = (Scheme_Object *)letrec;
else else
first = (Scheme_Object *)letrec; first = (Scheme_Object *)letrec;
} else if (last) } else if (last)
last->body = body; last->body = body;
else if (last_body) else if (last_body)
SCHEME_CDR(last_body) = body; SCHEME_CDR(last_body) = body;
else if (last_seq)
((Scheme_Sequence *)last_seq)->array[1] = (Scheme_Object *)body;
else else
first = body; first = body;