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

another minor ad hoc optimization

Browse Source 
svn: r15433
This commit is contained in:
Matthew Flatt 2009-07-11 15:23:35 +00:00
parent ba87f38f72
commit 57a046c5f8
3 changed files with 39 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/mzscheme/src/eval.c
View File

@ -1304,6 +1304,11 @@ static void set_app2_eval_type(Scheme_App2_Rec *app)
SCHEME_APPN_FLAGS(app) = et;
}
void scheme_reset_app2_eval_type(Scheme_App2_Rec *app)
{
set_app2_eval_type(app);
}
static Scheme_Object *resolve_application2(Scheme_Object *o, Resolve_Info *orig_info, int already_resolved_arg_count)
{
Resolve_Info *info;

2
src/mzscheme/src/schpriv.h
View File

@ -2122,6 +2122,8 @@ Scheme_Closure *scheme_malloc_empty_closure(void);
Scheme_Object *scheme_make_native_closure(Scheme_Native_Closure_Data *code);
Scheme_Object *scheme_make_native_case_closure(Scheme_Native_Closure_Data *code);
void scheme_reset_app2_eval_type(Scheme_App2_Rec *app);
Scheme_Native_Closure_Data *scheme_generate_case_lambda(Scheme_Case_Lambda *cl);
void scheme_delay_load_closure(Scheme_Closure_Data *data);

32
src/mzscheme/src/syntax.c
View File

@ -3786,6 +3786,38 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
if (info->max_let_depth < max_let_depth)
info->max_let_depth = max_let_depth;
/* Check for (let ([x <expr>]) (<simple> x)) at end, and change to
(<simple> <expr>). This is easy because the local-variable
offsets in <expr> do not change (as long as <simple> doesn't
access the stack). */
last_body = NULL;
body = first;
while (1) {
if (!SAME_TYPE(SCHEME_TYPE(body), scheme_let_one_type))
break;
if (!SAME_TYPE(SCHEME_TYPE(((Scheme_Let_One *)body)->body), scheme_let_one_type))
break;
last_body = body;
body = ((Scheme_Let_One *)body)->body;
}
if (SAME_TYPE(SCHEME_TYPE(body), scheme_let_one_type)) {
if (SAME_TYPE(SCHEME_TYPE(((Scheme_Let_One *)body)->body), scheme_application2_type)) {
Scheme_App2_Rec *app = (Scheme_App2_Rec *)((Scheme_Let_One *)body)->body;
if (SAME_TYPE(SCHEME_TYPE(app->rand), scheme_local_type)
&& (SCHEME_LOCAL_POS(app->rand) == 1)) {
if (SCHEME_TYPE(app->rator) > _scheme_values_types_) {
/* Move <expr> to app, and drop let-one: */
app->rand = ((Scheme_Let_One *)body)->value;
scheme_reset_app2_eval_type(app);
if (last_body)
((Scheme_Let_One *)last_body)->body = (Scheme_Object *)app;
else
first = (Scheme_Object *)app;
}
}
}
}
return first;
} else {
/* Maybe some multi-binding lets, but all of them are unused