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

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1358,7 +1358,15 @@
(begin0 y (set! y 5))))) (begin0 y (set! y 5)))))
(test-comp '(lambda (w) (car w) (mcar w)) (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 for unary aplications
(test-comp -1 (test-comp -1

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

@ -1930,6 +1930,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
if (bad_app) { if (bad_app) {
int len; int len;
const char *pname, *context; const char *pname, *context;
info->escapes = 1;
pname = scheme_get_proc_name(bad_app, &len, 0); pname = scheme_get_proc_name(bad_app, &len, 0);
context = scheme_optimize_context_to_string(info->context); context = scheme_optimize_context_to_string(info->context);
scheme_log(info->logger, scheme_log(info->logger,
@ -2575,7 +2576,7 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info
{ {
Scheme_Object *le; Scheme_Object *le;
Scheme_App_Rec *app; 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; Optimize_Info_Sequence info_seq;
app = (Scheme_App_Rec *)o; 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); return scheme_make_sequence_compilation(l, 1);
} }
if (!i) { if (!i) {
/* Maybe found "((lambda" after optimizing; try again */ /* Maybe found "((lambda" after optimizing; try again */
le = optimize_for_inline(info, app->args[i], n - 1, app, NULL, NULL, &rator_flags, context, 1); le = optimize_for_inline(info, app->args[i], n - 1, app, NULL, NULL, &rator_flags, context, 1);
if (le) if (le)
return 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; 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); 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_App2_Rec *app;
Scheme_Object *le; 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; Optimize_Info_Sequence info_seq;
app = (Scheme_App2_Rec *)o; 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); le = optimize_for_inline(info, app->rator, 1, NULL, app, NULL, &rator_flags, context, 1);
if (le) if (le)
return le; return le;
rator_apply_escapes = info->escapes;
} }
if (SAME_PTR(scheme_not_prim, app->rator)){ 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); 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); 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_App3_Rec *app;
Scheme_Object *le; 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; Optimize_Info_Sequence info_seq;
app = (Scheme_App3_Rec *)o; 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); le = optimize_for_inline(info, app->rator, 2, NULL, NULL, app, &rator_flags, context, 1);
if (le) if (le)
return le; return le;
rator_apply_escapes = info->escapes;
} }
/* 1st arg */ /* 1st arg */
@ -3324,6 +3337,11 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf
flags = appn_flags(app->rator, info); flags = appn_flags(app->rator, info);
SCHEME_APPN_FLAGS(app) |= flags; 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); return finish_optimize_application3(app, info, context, rator_flags);
} }