remove @call-with-values memoizer

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

* libguile/memoize.c (memoize, m_call_values, unmemoize): Adapt to
  memoize call-with-values primcalls.

* module/ice-9/boot-9.scm (call-with-values): Expand to a
  call-with-values primcall.

* module/language/tree-il/compile-glil.scm (flatten-lambda-case): Expect
  call-with-values primcall, without the @, and fall back to a normal
  call.

* module/language/tree-il/peval.scm (peval): Match bare
  call-with-values.

* module/language/tree-il/primitives.scm (*interesting-primitive-names*):
  (*multiply-valued-primitives*): Remove @call-with-values.

7 files changed, 12 insertions, 23 deletions

diff --git a/libguile/expand.c b/libguile/expand.c
index 003494cb7..38d70774b 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -180,7 +180,6 @@ SCM_GLOBAL_SYMBOL (scm_sym_apply, "apply");
 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_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 2975f5686..2cad1bb10 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -287,6 +287,10 @@ memoize (SCM exp, SCM env)
                                scm_from_latin1_symbol
                                ("call-with-current-continuation")))
           return MAKMEMO_CONT (CAR (args));
+        else if (nargs == 2
+                 && scm_is_eq (name,
+                               scm_from_latin1_symbol ("call-with-values")))
+          return MAKMEMO_CALL_WITH_VALUES (CAR (args), CADR (args));
         else if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
           return MAKMEMO_CALL (MAKMEMO_TOP_REF (name), nargs, args);
         else
@@ -532,24 +536,13 @@ 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_values (SCM prod, SCM cons);
 static SCM m_dynamic_wind (SCM pre, SCM exp, SCM post);
 
-SCM_DEFINE_MEMOIZER ("@call-with-values", m_call_values, 2);
 SCM_DEFINE_MEMOIZER ("@dynamic-wind", m_dynamic_wind, 3);
 
 
 
 
-static SCM m_call_values (SCM prod, SCM cons)
-#define FUNC_NAME "@call-with-values"
-{
-  SCM_VALIDATE_MEMOIZED (1, prod);
-  SCM_VALIDATE_MEMOIZED (2, cons);
-  return MAKMEMO_CALL_WITH_VALUES (prod, cons);
-}
-#undef FUNC_NAME
-
 static SCM m_dynamic_wind (SCM in, SCM expr, SCM out)
 #define FUNC_NAME "memoize-dynwind"
 {
@@ -633,7 +626,7 @@ unmemoize (const SCM expr)
                          ("call-with-current_continuation"),
                          unmemoize (args));
     case SCM_M_CALL_WITH_VALUES:
-      return scm_list_3 (scm_sym_at_call_with_values,
+      return scm_list_3 (scm_from_latin1_symbol ("call-with-values"),
                          unmemoize (CAR (args)), unmemoize (CDR (args)));
     case SCM_M_DEFINE:
       return scm_list_3 (scm_sym_define, CAR (args), unmemoize (CDR (args)));
diff --git a/libguile/memoize.h b/libguile/memoize.h
index b12c60b8f..7b4d716c9 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_at_call_with_values;
 SCM_API SCM scm_sym_delay;
 SCM_API SCM scm_sym_at_dynamic_wind;
 SCM_API SCM scm_sym_eval_when;
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 9243d383f..c99ca40cb 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -215,7 +215,7 @@ If there is no handler at all, Guile prints an error and then exits."
 (define (call-with-current-continuation proc)
   ((@@ primitive call-with-current-continuation) proc))
 (define (call-with-values producer consumer)
-  (@call-with-values producer consumer))
+  ((@@ primitive call-with-values) producer consumer))
 (define (dynamic-wind in thunk out)
   "All three arguments must be 0-argument procedures.
 Guard @var{in} is called, then @var{thunk}, then
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index 3f289c24d..2aad6a1f2 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -432,7 +432,7 @@
                                   (make-glil-call 'return 1)
                                   (make-glil-call 'return/values len)))))))
         
-         ((@call-with-values ,producer ,consumer)
+         ((call-with-values ,producer ,consumer)
           ;; CONSUMER
           ;; PRODUCER
           ;; (mv-call MV)
@@ -443,7 +443,8 @@
           (case context
             ((vals)
              ;; Fall back.
-             (comp-tail (make-primcall src 'call-with-values args)))
+             (comp-tail
+              (make-call src (make-toplevel-ref #f 'call-with-values) args)))
             (else
              (let ((MV (make-label)) (POST (make-label)))
                (if (not (eq? context 'tail))
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index a7504fdf8..662adb493 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1115,7 +1115,7 @@ top-level bindings from ENV and return the resulting expression."
           (simplify-conditional
            (make-conditional src c (for-tail subsequent)
                              (for-tail alternate))))))
-      (($ <primcall> src '@call-with-values
+      (($ <primcall> src 'call-with-values
           (producer
            ($ <lambda> _ _
               (and consumer
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 212910620..4036b7ede 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -37,7 +37,7 @@
 ;; if appropriate.
 (define *interesting-primitive-names* 
   '(apply
-    call-with-values @call-with-values
+    call-with-values
     call-with-current-continuation
     call/cc
     dynamic-wind
@@ -181,7 +181,7 @@
 ;; Primitives that don't always return one value.
 (define *multiply-valued-primitives* 
   '(apply
-    call-with-values @call-with-values
+    call-with-values
     call-with-current-continuation
     call/cc
     dynamic-wind
@@ -448,9 +448,6 @@
 (define-primitive-expander acons (x y z)
   (cons (cons x y) z))
 
-(define-primitive-expander call-with-values (producer consumer)
-  (@call-with-values producer consumer))
-
 (define-primitive-expander call/cc (proc)
   (call-with-current-continuation proc))