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

fix cross-module inlining for multi-arity functions

Browse Source 
First use of the function was determining a single arity for
the enclosing module, and that arity could trigger warnings
in addition to failures to inline. For example, using `map'
on 3 arguments would trigger incorrect warnings for later
uses of `map' on 2 arguments.
This commit is contained in:
Matthew Flatt 2011-12-28 20:25:34 -06:00
parent 753fd77858
commit 4fe30cf433
3 changed files with 26 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1013,18 +1013,35 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
if (info->cp->inline_variants) {
Scheme_Object *iv;
iv = scheme_hash_get(info->cp->inline_variants, scheme_make_integer(pos));
if (iv) {
if (SAME_TYPE(SCHEME_TYPE(iv), scheme_inline_variant_type)) {
iv = scheme_unresolve(iv, argc);
scheme_hash_set(info->cp->inline_variants, scheme_make_integer(pos), iv);
if (iv && SCHEME_TRUEP(iv)) {
Scheme_Hash_Table *iv_ht = NULL;
if (SCHEME_HASHTP(iv)) {
iv_ht = (Scheme_Hash_Table *)iv;
iv = scheme_hash_get(iv_ht, scheme_make_integer(argc));
if (!iv)
iv = scheme_hash_get(iv_ht, scheme_false);
}
if (iv) {
if (SAME_TYPE(SCHEME_TYPE(iv), scheme_inline_variant_type)) {
int has_cases;
Scheme_Object *orig_iv = iv;
iv = scheme_unresolve(iv, argc, &has_cases);
if (has_cases) {
if (!iv_ht) {
iv_ht = scheme_make_hash_table(SCHEME_hash_ptr);
scheme_hash_set(iv_ht, scheme_false, orig_iv);
scheme_hash_set(info->cp->inline_variants, scheme_make_integer(pos), (Scheme_Object *)iv_ht);
}
scheme_hash_set(iv_ht, scheme_make_integer(argc), iv ? iv : scheme_false);
} else
scheme_hash_set(info->cp->inline_variants, scheme_make_integer(pos), iv ? iv : scheme_false);
}
if (iv && SCHEME_TRUEP(iv)) {
le = iv;
break;
}
}
}
if (info->top_level_consts) {
if (SAME_TYPE(SCHEME_TYPE(le), scheme_compiled_toplevel_type) && info->top_level_consts) {
le = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos));
if (le && SCHEME_BOXP(le)) {
psize = SCHEME_INT_VAL(SCHEME_BOX_VAL(le));

3
src/racket/src/resolve.c
View File

@ -3514,7 +3514,7 @@ static Scheme_Object *unresolve_expr(Scheme_Object *e, Unresolve_Info *ui, int a
}
}
Scheme_Object *scheme_unresolve(Scheme_Object *iv, int argc)
Scheme_Object *scheme_unresolve(Scheme_Object *iv, int argc, int *_has_cases)
{
Scheme_Object *o;
Scheme_Closure_Data *data = NULL;
@ -3530,6 +3530,7 @@ Scheme_Object *scheme_unresolve(Scheme_Object *iv, int argc)
Scheme_Case_Lambda *seqin = (Scheme_Case_Lambda *)o;
int i, cnt;
cnt = seqin->count;
if (cnt > 1) *_has_cases = 1;
for (i = 0; i < cnt; i++) {
if (SAME_TYPE(SCHEME_TYPE(seqin->array[i]), scheme_closure_type)) {
/* An empty closure, created at compile time */

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

@ -2621,7 +2621,7 @@ Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e);
Scheme_Object *scheme_resolve_expr(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_resolve_list(Scheme_Object *, Resolve_Info *);
Scheme_Object *scheme_unresolve(Scheme_Object *, int argv);
Scheme_Object *scheme_unresolve(Scheme_Object *, int argv, int *_has_cases);
int scheme_check_leaf_rator(Scheme_Object *le, int *_flags);