From 27791ebab74fa3628f5f9d014766168a95edde1b Mon Sep 17 00:00:00 2001
From: Gustavo Massaccesi <gustavo@oma.org.ar>
Date: Mon, 7 Sep 2015 14:11:56 -0300
Subject: [PATCH] Remove ignored call/cc

Reduce (call/cc (lambda (<ignored>) body ...)) to (begin body ...)
---
 .../tests/racket/optimize.rktl                | 10 +++++
 racket/src/racket/src/optimize.c              | 44 +++++++++++++++++++
 2 files changed, 54 insertions(+)

diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl
index 765556b6c2..6ee590e510 100644
--- a/pkgs/racket-test-core/tests/racket/optimize.rktl
+++ b/pkgs/racket-test-core/tests/racket/optimize.rktl
@@ -3539,6 +3539,16 @@
               (set! f 0))
            #f)
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check that the unused continuations are removed
+
+(test-comp '(call-with-current-continuation (lambda (ignored) 5))
+           5)
+(test-comp '(call-with-composable-continuation (lambda (ignored) 5))
+           5)
+(test-comp '(call-with-escape-continuation (lambda (ignored) 5))
+           5)
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check splitting of definitions
 (test-comp `(module m racket/base
diff --git a/racket/src/racket/src/optimize.c b/racket/src/racket/src/optimize.c
index e3ae38b326..51b90cbca0 100644
--- a/racket/src/racket/src/optimize.c
+++ b/racket/src/racket/src/optimize.c
@@ -3062,6 +3062,46 @@ static Scheme_Object *try_reduce_predicate(Scheme_Object *rator, Scheme_Object *
   return make_discarding_sequence(rand, (matches ? scheme_true : scheme_false), info, id_offset);
 }
 
+static Scheme_Object *check_ignored_call_cc(Scheme_Object *rator, Scheme_Object *rand,
+                                            Optimize_Info *info, int context)
+/* Convert (call/cc (lambda (ignored) body ...)) to (begin body ...) */
+{
+  if (SCHEME_PRIMP(rator)
+      && (IS_NAMED_PRIM(rator, "call-with-current-continuation")
+          || IS_NAMED_PRIM(rator, "call-with-composable-continuation")
+          || IS_NAMED_PRIM(rator, "call-with-escape-continuation"))) {
+      int rand_flags;
+      Scheme_Object *proc;
+      proc = lookup_constant_proc(info, rand, 0);
+      if (!proc)
+        proc = optimize_for_inline(info, rand, 1, NULL, NULL, NULL, &rand_flags, context, 0, 0);
+
+      if (proc && SAME_TYPE(SCHEME_TYPE(proc), scheme_compiled_unclosed_procedure_type)) {
+          Scheme_Closure_Data *data = (Scheme_Closure_Data *)proc;
+          if (data->num_params == 1) {
+              Closure_Info *cl = (Closure_Info *)data->closure_map;
+              if (((cl->local_flags[0] & SCHEME_USE_COUNT_MASK) >> SCHEME_USE_COUNT_SHIFT) == 0) {
+                Scheme_Object *expr;
+                info->vclock++;
+                expr = make_application_2(rand, scheme_void, info);
+                if (IS_NAMED_PRIM(rator, "call-with-escape-continuation")) {
+                  Scheme_Sequence *seq;
+
+                  seq = scheme_malloc_sequence(1);
+                  seq->so.type = scheme_begin0_sequence_type;
+                  seq->count = 1;
+                  seq->array[0] = expr;
+                  
+                  expr = (Scheme_Object *)seq;
+                }                
+                return scheme_optimize_expr(expr, info, context);
+              }
+          }
+      }
+  }
+  return NULL;
+}
+
 static Scheme_Object *make_optimize_prim_application2(Scheme_Object *prim, Scheme_Object *rand,
                                                       Optimize_Info *info, int context)
 /* make (prim rand) and optimize it. rand must be already optimized */
@@ -3091,6 +3131,10 @@ static Scheme_Object *optimize_application2(Scheme_Object *o, Optimize_Info *inf
   if (le)
     return le;
 
+  le = check_ignored_call_cc(app->rator, app->rand, info, context);
+  if (le)
+    return le;
+
   le = optimize_for_inline(info, app->rator, 1, NULL, app, NULL, &rator_flags, context, 0, 0);
   if (le)
     return le;