1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00

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.
This commit is contained in:
Andy Wingo 2013-06-27 12:20:36 +02:00
parent bc056057c8
commit 0fcc39a0a9
7 changed files with 12 additions and 23 deletions

View file

@ -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");

View file

@ -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)));

View file

@ -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;

View file

@ -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

View file

@ -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))

View file

@ -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

View file

@ -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))