fix cross-module inlining for multi-arity functions
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:
parent
753fd77858
commit
4fe30cf433
|
@ -1013,18 +1013,35 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
|
||||||
if (info->cp->inline_variants) {
|
if (info->cp->inline_variants) {
|
||||||
Scheme_Object *iv;
|
Scheme_Object *iv;
|
||||||
iv = scheme_hash_get(info->cp->inline_variants, scheme_make_integer(pos));
|
iv = scheme_hash_get(info->cp->inline_variants, scheme_make_integer(pos));
|
||||||
if (iv) {
|
if (iv && SCHEME_TRUEP(iv)) {
|
||||||
if (SAME_TYPE(SCHEME_TYPE(iv), scheme_inline_variant_type)) {
|
Scheme_Hash_Table *iv_ht = NULL;
|
||||||
iv = scheme_unresolve(iv, argc);
|
if (SCHEME_HASHTP(iv)) {
|
||||||
scheme_hash_set(info->cp->inline_variants, scheme_make_integer(pos), 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;
|
le = iv;
|
||||||
break;
|
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));
|
le = scheme_hash_get(info->top_level_consts, scheme_make_integer(pos));
|
||||||
if (le && SCHEME_BOXP(le)) {
|
if (le && SCHEME_BOXP(le)) {
|
||||||
psize = SCHEME_INT_VAL(SCHEME_BOX_VAL(le));
|
psize = SCHEME_INT_VAL(SCHEME_BOX_VAL(le));
|
||||||
|
|
|
@ -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_Object *o;
|
||||||
Scheme_Closure_Data *data = NULL;
|
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;
|
Scheme_Case_Lambda *seqin = (Scheme_Case_Lambda *)o;
|
||||||
int i, cnt;
|
int i, cnt;
|
||||||
cnt = seqin->count;
|
cnt = seqin->count;
|
||||||
|
if (cnt > 1) *_has_cases = 1;
|
||||||
for (i = 0; i < cnt; i++) {
|
for (i = 0; i < cnt; i++) {
|
||||||
if (SAME_TYPE(SCHEME_TYPE(seqin->array[i]), scheme_closure_type)) {
|
if (SAME_TYPE(SCHEME_TYPE(seqin->array[i]), scheme_closure_type)) {
|
||||||
/* An empty closure, created at compile time */
|
/* An empty closure, created at compile time */
|
||||||
|
|
|
@ -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_expr(Scheme_Object *, Resolve_Info *);
|
||||||
Scheme_Object *scheme_resolve_list(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);
|
int scheme_check_leaf_rator(Scheme_Object *le, int *_flags);
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user