From 4fe30cf43342ecb18825c7b703ef50d419da169d Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 28 Dec 2011 20:25:34 -0600
Subject: [PATCH] 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.
---
 src/racket/src/optimize.c | 29 +++++++++++++++++++++++------
 src/racket/src/resolve.c  |  3 ++-
 src/racket/src/schpriv.h  |  2 +-
 3 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/src/racket/src/optimize.c b/src/racket/src/optimize.c
index 62635729be..1b608e5e79 100644
--- a/src/racket/src/optimize.c
+++ b/src/racket/src/optimize.c
@@ -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));
diff --git a/src/racket/src/resolve.c b/src/racket/src/resolve.c
index 76d79c612d..fc5106d80f 100644
--- a/src/racket/src/resolve.c
+++ b/src/racket/src/resolve.c
@@ -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 */
diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h
index c070998311..2d211ca802 100644
--- a/src/racket/src/schpriv.h
+++ b/src/racket/src/schpriv.h
@@ -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);