remove @call-with-current-continuation memoizer

* module/ice-9/boot-9.scm (call-with-current-continuation): Change to
  primcall call-with-current-continuation.

* libguile/memoize.h:
* libguile/expand.c (scm_sym_atcall_cc): Remove.

* libguile/memoize.c (memoize): Memoize call/cc primcalls to
  SCM_M_CONT.
  (m_call_cc): Remove.
  (unmemoize): Unmemoize to call-with-current-continuation.

* module/language/tree-il/compile-glil.scm (flatten-lambda-case): Update
  to call-with-current-continuation without @ prefix, and fix fallback
  case.

* module/language/tree-il/primitives.scm (*multiply-valued-primitives*):
  (*interesting-primitive-names*): Remove
  @call-with-current-continuation.
  (call/cc): Expand to call-with-current-continuation.

* test-suite/tests/tree-il.test ("call/cc"): Update to use and expect
  call-with-current-continuation primcalls / toplevel refs.

7 files changed, 22 insertions, 26 deletions

diff --git a/libguile/expand.c b/libguile/expand.c
index 28636a462..003494cb7 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -181,7 +181,6 @@ SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>");
 SCM_GLOBAL_SYMBOL (scm_sym_at, "@");
 SCM_GLOBAL_SYMBOL (scm_sym_atat, "@@");
 SCM_GLOBAL_SYMBOL (scm_sym_at_call_with_values, "@call-with-values");
-SCM_GLOBAL_SYMBOL (scm_sym_atcall_cc, "@call-with-current-continuation");
 SCM_GLOBAL_SYMBOL (scm_sym_begin, "begin");
 SCM_GLOBAL_SYMBOL (scm_sym_case, "case");
 SCM_GLOBAL_SYMBOL (scm_sym_cond, "cond");
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 12e670ae1..2975f5686 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -282,6 +282,11 @@ memoize (SCM exp, SCM env)
         else if (nargs == 2
                  && scm_is_eq (name, scm_from_latin1_symbol ("apply")))
           return MAKMEMO_APPLY (CAR (args), CADR (args));
+        else if (nargs == 1
+                 && scm_is_eq (name,
+                               scm_from_latin1_symbol
+                               ("call-with-current-continuation")))
+          return MAKMEMO_CONT (CAR (args));
         else if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
           return MAKMEMO_CALL (MAKMEMO_TOP_REF (name), nargs, args);
         else
@@ -527,25 +532,15 @@ SCM_DEFINE (scm_memoize_expression, "memoize-expression", 1, 0, 0,
 #define SCM_DEFINE_MEMOIZER(STR, MEMOIZER, N)                           \
 SCM_SNARF_INIT(scm_c_define (STR, SCM_MAKE_MEMOIZER (STR, MEMOIZER, N)))
 
-static SCM m_call_cc (SCM proc);
 static SCM m_call_values (SCM prod, SCM cons);
 static SCM m_dynamic_wind (SCM pre, SCM exp, SCM post);
 
-SCM_DEFINE_MEMOIZER ("@call-with-current-continuation", m_call_cc, 1);
 SCM_DEFINE_MEMOIZER ("@call-with-values", m_call_values, 2);
 SCM_DEFINE_MEMOIZER ("@dynamic-wind", m_dynamic_wind, 3);
 
 
 
 
-static SCM m_call_cc (SCM proc)
-#define FUNC_NAME "@call-with-current-continuation"
-{
-  SCM_VALIDATE_MEMOIZED (1, proc);
-  return MAKMEMO_CONT (proc);
-}
-#undef FUNC_NAME
-
 static SCM m_call_values (SCM prod, SCM cons)
 #define FUNC_NAME "@call-with-values"
 {
@@ -634,7 +629,9 @@ unmemoize (const SCM expr)
     case SCM_M_CALL:
       return scm_cons (unmemoize (CAR (args)), unmemoize_exprs (CDDR (args)));
     case SCM_M_CONT:
-      return scm_list_2 (scm_sym_atcall_cc, unmemoize (args));
+      return scm_list_2 (scm_from_latin1_symbol
+                         ("call-with-current_continuation"),
+                         unmemoize (args));
     case SCM_M_CALL_WITH_VALUES:
       return scm_list_3 (scm_sym_at_call_with_values,
                          unmemoize (CAR (args)), unmemoize (CDR (args)));
diff --git a/libguile/memoize.h b/libguile/memoize.h
index 3bd37ebbd..b12c60b8f 100644
--- a/libguile/memoize.h
+++ b/libguile/memoize.h
@@ -48,7 +48,6 @@ SCM_API SCM scm_sym_with_fluids;
 
 SCM_API SCM scm_sym_at;
 SCM_API SCM scm_sym_atat;
-SCM_API SCM scm_sym_atcall_cc;
 SCM_API SCM scm_sym_at_call_with_values;
 SCM_API SCM scm_sym_delay;
 SCM_API SCM scm_sym_at_dynamic_wind;
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 7760a2c38..9243d383f 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -213,7 +213,7 @@ If there is no handler at all, Guile prints an error and then exits."
                                (cons tail (append* tail*)))))))
        (apply fun (cons arg1 (append* args)))))))
 (define (call-with-current-continuation proc)
-  (@call-with-current-continuation proc))
+  ((@@ primitive call-with-current-continuation) proc))
 (define (call-with-values producer consumer)
   (@call-with-values producer consumer))
 (define (dynamic-wind in thunk out)
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index c211f37e7..3f289c24d 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -465,14 +465,16 @@
                              (emit-code #f (make-glil-call 'drop 1)))
                          (maybe-emit-return)))))))
 
-         ((@call-with-current-continuation ,proc)
+         ((call-with-current-continuation ,proc)
           (case context
             ((tail)
              (comp-push proc)
              (emit-code src (make-glil-call 'tail-call/cc 1)))
             ((vals)
              (comp-vals
-              (make-primcall src 'call-with-current-continuation args)
+              (make-call src
+                         (make-primitive-ref #f 'call-with-current-continuation)
+                         args)
               MVRA)
              (maybe-emit-return))
             ((push)
@@ -482,7 +484,9 @@
             ((drop)
              ;; Fall back.
              (comp-tail
-              (make-primcall src 'call-with-current-continuation args)))))
+              (make-call src
+                         (make-primitive-ref #f 'call-with-current-continuation)
+                         args)))))
          
         ;; A hack for variable-set, the opcode for which takes its args
         ;; reversed, relative to the variable-set! function
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index db80d8a89..212910620 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -38,7 +38,7 @@
 (define *interesting-primitive-names* 
   '(apply
     call-with-values @call-with-values
-    call-with-current-continuation @call-with-current-continuation
+    call-with-current-continuation
     call/cc
     dynamic-wind
     @dynamic-wind
@@ -182,7 +182,7 @@
 (define *multiply-valued-primitives* 
   '(apply
     call-with-values @call-with-values
-    call-with-current-continuation @call-with-current-continuation
+    call-with-current-continuation
     call/cc
     dynamic-wind
     @dynamic-wind
@@ -451,11 +451,8 @@
 (define-primitive-expander call-with-values (producer consumer)
   (@call-with-values producer consumer))
 
-(define-primitive-expander call-with-current-continuation (proc)
-  (@call-with-current-continuation proc))
-
 (define-primitive-expander call/cc (proc)
-  (@call-with-current-continuation proc))
+  (call-with-current-continuation proc))
 
 (define-primitive-expander make-struct (vtable tail-size . args)
   (if (and (const? tail-size)
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 059cb8261..edcbdc983 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -672,10 +672,10 @@
 
 (with-test-prefix "call/cc"
   (assert-tree-il->glil
-   (primcall @call-with-current-continuation (toplevel foo))
+   (primcall call-with-current-continuation (toplevel foo))
    (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call tail-call/cc 1)))
   (assert-tree-il->glil
-   (begin (primcall @call-with-current-continuation (toplevel foo)) (void))
+   (begin (primcall call-with-current-continuation (toplevel foo)) (void))
    (program () (std-prelude 0 0 #f) (label _)
             (call new-frame 0) (toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1)
             (call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f)
@@ -684,7 +684,7 @@
    (and (eq? l1 l3) (eq? l2 l4)))
   (assert-tree-il->glil
    (call (toplevel foo)
-          (call (toplevel @call-with-current-continuation) (toplevel bar)))
+          (call (toplevel call-with-current-continuation) (toplevel bar)))
    (program () (std-prelude 0 0 #f) (label _)
             (toplevel ref foo)
             (toplevel ref bar) (call call/cc 1)