From 01458e22fa87fb9b8b22ce4b6ca019a277382069 Mon Sep 17 00:00:00 2001
From: Gustavo Massaccesi <gustavo@oma.org.ar>
Date: Fri, 13 Nov 2015 08:38:55 -0300
Subject: [PATCH] Don't burn fuel when a single use function is inlined

Since this operation only moves the code and doesn't make the final
bytecode bigger, it's not necessary to decrease the fuel and then it
is available for further inlining.
---
 pkgs/racket-test-core/tests/racket/optimize.rktl | 14 ++++++++++++++
 racket/src/racket/src/optimize.c                 | 13 +++++++++----
 racket/src/racket/src/schpriv.h                  |  2 +-
 3 files changed, 24 insertions(+), 5 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl
index ca09716c65..4c2d40d365 100644
--- a/pkgs/racket-test-core/tests/racket/optimize.rktl
+++ b/pkgs/racket-test-core/tests/racket/optimize.rktl
@@ -5214,6 +5214,20 @@
   (test 'x syntax-e ((f))))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Make sure the compiler doesn't try to inline forever a curried
+;; version of an infinite loop:
+
+(module curried-module-level-function-calls-itself racket/base
+  (define ((proc))
+    ((proc))))
+
+(module curried-local-function-calls-itself racket/base
+  (let ()
+    (define ((proc))
+      ((proc)))
+    (void proc proc)))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
 (report-errs)
diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c
index 5c77298283..503ac68bf9 100644
--- a/racket/src/racket/src/optimize.c
+++ b/racket/src/racket/src/optimize.c
@@ -1799,7 +1799,8 @@ static Scheme_Object *no_potential_size(Scheme_Object *v)
 
 static Scheme_Object *apply_inlined(Scheme_Lambda *lam, Optimize_Info *info,
 				    int argc, Scheme_App_Rec *app, Scheme_App2_Rec *app2, Scheme_App3_Rec *app3,
-                                    int context, Scheme_Object *orig, Scheme_Object *le_prev)
+                                    int context, Scheme_Object *orig, Scheme_Object *le_prev,
+                                    int single_use)
 /* Optimize the body of `lam` given the known arguments in `app`, `app2`, or `app3` */
 {
   Scheme_IR_Let_Header *lh;
@@ -1815,7 +1816,8 @@ static Scheme_Object *apply_inlined(Scheme_Lambda *lam, Optimize_Info *info,
   if (!expected) {
     /* No arguments, so no need for a `let` wrapper: */
     sub_info = optimize_info_add_frame(info, 0, 0, 0);
-    sub_info->inline_fuel >>= 1;
+    if (!single_use || lam->ir_info->is_dup)
+      sub_info->inline_fuel >>= 1;
     p = scheme_optimize_expr(p, sub_info, context);
     info->single_result = sub_info->single_result;
     info->preserves_marks = sub_info->preserves_marks;
@@ -1880,7 +1882,8 @@ static Scheme_Object *apply_inlined(Scheme_Lambda *lam, Optimize_Info *info,
     lh->body = p;
 
   sub_info = optimize_info_add_frame(info, 0, 0, 0);
-  sub_info->inline_fuel >>= 1;
+  if (!single_use || lam->ir_info->is_dup)
+    sub_info->inline_fuel >>= 1;
 
   p = scheme_optimize_lets((Scheme_Object *)lh, sub_info, 1, context);
 
@@ -2077,7 +2080,7 @@ Scheme_Object *optimize_for_inline(Optimize_Info *info, Scheme_Object *le, int a
 		     threshold,
 		     scheme_optimize_context_to_string(info->context));
           le = apply_inlined((Scheme_Lambda *)le, sub_info, argc, app, app2, app3, context,
-                             orig_le, prev);
+                             orig_le, prev, single_use);
           return le;
 	} else {
           LOG_INLINE(fprintf(stderr, "No inline %s\n", scheme_write_to_string(lam->name ? lam->name : scheme_false, NULL)));
@@ -6850,6 +6853,8 @@ static Scheme_Object *clone_lambda(int single_use, Scheme_Object *_lam, Optimize
   vars = clone_variable_array(cl->vars, lam2->num_params, &var_map);
   cl->vars = vars;
 
+  cl->is_dup |= !single_use;
+
   body = optimize_clone(single_use, lam->body, info, var_map, 0);
   if (!body) return NULL;
 
diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h
index 7bc2b8056a..ffa68b2837 100644
--- a/racket/src/racket/src/schpriv.h
+++ b/racket/src/racket/src/schpriv.h
@@ -2851,7 +2851,7 @@ typedef struct {
   Scheme_Hash_Table *base_closure;
   Scheme_IR_Local **vars;
   char *local_type_map; /* determined by callers; NULL when has_tymap set => no local types */
-  char has_tl, has_tymap, has_nonleaf;
+  char has_tl, has_tymap, has_nonleaf, is_dup;
   int body_size, body_psize;
 } Scheme_IR_Lambda_Info;