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:
parent
bc056057c8
commit
0fcc39a0a9
7 changed files with 12 additions and 23 deletions
|
@ -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");
|
||||
|
|
|
@ -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)));
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue