Mark error in expression when an arity mismatch is detected during optimization

This enables further reductions, for example (begin (car x x) z) => (car x x)
This commit is contained in:
Gustavo Massaccesi 2015-01-01 18:16:41 -03:00 committed by Matthew Flatt
parent 6d8ba1fd67
commit feb8f10165
2 changed files with 31 additions and 5 deletions

View File

@ -1358,7 +1358,15 @@
(begin0 y (set! y 5)))))
(test-comp '(lambda (w) (car w) (mcar w))
'(lambda (w) (begin (car w) (mcar w) (random))))
'(lambda (w) (car w) (mcar w) (random)))
(test-comp '(lambda (w) (car w w))
'(lambda (w) (car w w) (random)))
(test-comp '(lambda (w) (car w w w))
'(lambda (w) (car w w w) (random)))
(test-comp '(lambda (w) (cons w))
'(lambda (w) (cons w) (random)))
(test-comp '(lambda (w) (cons))
'(lambda (w) (cons) (random)))
; test for unary aplications
(test-comp -1

View File

@ -1930,6 +1930,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
if (bad_app) {
int len;
const char *pname, *context;
info->escapes = 1;
pname = scheme_get_proc_name(bad_app, &len, 0);
context = scheme_optimize_context_to_string(info->context);
scheme_log(info->logger,
@ -2575,7 +2576,7 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
{
Scheme_Object *le;
Scheme_App_Rec *app;
int i, n, rator_flags = 0, sub_context = 0;
int i, n, rator_apply_escapes = 0, rator_flags = 0, sub_context = 0;
Optimize_Info_Sequence info_seq;
app = (Scheme_App_Rec *)o;
@ -2630,12 +2631,12 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
return scheme_make_sequence_compilation(l, 1);
}
if (!i) {
/* Maybe found "((lambda" after optimizing; try again */
le = optimize_for_inline(info, app->args[i], n - 1, app, NULL, NULL, &rator_flags, context, 1);
if (le)
return le;
rator_apply_escapes = info->escapes;
}
}
@ -2656,6 +2657,11 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
app->args[3] = ((Scheme_Closure_Data *)app->args[3])->code;
}
if (rator_apply_escapes) {
info->escapes = 1;
SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
}
return finish_optimize_application(app, info, context, rator_flags);
}
@ -2930,7 +2936,7 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
{
Scheme_App2_Rec *app;
Scheme_Object *le;
int rator_flags = 0, sub_context, ty;
int rator_flags = 0, rator_apply_escapes, sub_context, ty;
Optimize_Info_Sequence info_seq;
app = (Scheme_App2_Rec *)o;
@ -2959,6 +2965,7 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
le = optimize_for_inline(info, app->rator, 1, NULL, app, NULL, &rator_flags, context, 1);
if (le)
return le;
rator_apply_escapes = info->escapes;
}
if (SAME_PTR(scheme_not_prim, app->rator)){
@ -2979,6 +2986,11 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
return make_discarding_first_sequence(app->rator, app->rand, info, 0);
}
if (rator_apply_escapes) {
info->escapes = 1;
SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
}
return finish_optimize_application2(app, info, context, rator_flags);
}
@ -3235,7 +3247,7 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
{
Scheme_App3_Rec *app;
Scheme_Object *le;
int rator_flags = 0, sub_context, ty, flags;
int rator_flags = 0, rator_apply_escapes, sub_context, ty, flags;
Optimize_Info_Sequence info_seq;
app = (Scheme_App3_Rec *)o;
@ -3279,6 +3291,7 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
le = optimize_for_inline(info, app->rator, 2, NULL, NULL, app, &rator_flags, context, 1);
if (le)
return le;
rator_apply_escapes = info->escapes;
}
/* 1st arg */
@ -3324,6 +3337,11 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
flags = appn_flags(app->rator, info);
SCHEME_APPN_FLAGS(app) |= flags;
if (rator_apply_escapes) {
info->escapes = 1;
SCHEME_APPN_FLAGS(app) |= (APPN_FLAG_IMMED | APPN_FLAG_SFS_TAIL);
}
return finish_optimize_application3(app, info, context, rator_flags);
}