summaryrefslogtreecommitdiff
path: root/libguile/memoize.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-06-25 22:36:08 +0200
committerAndy Wingo <wingo@pobox.com>2013-06-27 11:31:21 +0200
commit1773bc7dd5f4c8a1d13c7cf2015f3a04c9299eeb (patch)
tree3a645fa1af56c5572d7d0933792930592e84ab6f /libguile/memoize.c
parent385049949aa52b8578334d073b2c63291a5d5274 (diff)
downloadguile-1773bc7dd5f4c8a1d13c7cf2015f3a04c9299eeb.tar.gz
Remove @prompt memoizer
* libguile/memoize.h: * libguile/memoize.c (MAKMEMO_CALL_WITH_PROMPT, memoize, unmemoize): Remove the @prompt memoizer in favor of recognizing call-with-prompt primcalls. Rename SCM_M_PROMPT to SCM_M_CALL_WITH_PROMPT, and pass a thunk instead of an expression so that it has normal applicative order. * libguile/expand.c (PRIMITIVE_REF, PRIMCALL, expand): Produce primcalls from forms whose car is a primitive. (expand_atat): Recognize (@@ primitive FOO) as being a primitive-ref. * module/ice-9/boot-9.scm (call-with-prompt): Instead of dispatching to the wonky @prompt memoizer, residualize a primcall to call-with-prompt. The memoizer will DTRT to allow call-with-prompt to be interpreted correctly without needing an additional binding. * module/ice-9/eval.scm (primitive-eval): Change the 'prompt clause to a call to call-with-prompt. * module/language/tree-il/primitives.scm: No more need to recognize @prompt. * libguile/eval.c (eval): Adapt to SCM_M_PROMPT renaming to SCM_M_CALL_WITH_PROMPT, and apply the thunk. * libguile/throw.c (pre_init_throw): Adapt to scm_abort_to_prompt_star rename.
Diffstat (limited to 'libguile/memoize.c')
-rw-r--r--libguile/memoize.c47
1 files changed, 22 insertions, 25 deletions
diff --git a/libguile/memoize.c b/libguile/memoize.c
index f20241c20..f4a4c9ef7 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -112,8 +112,8 @@ scm_t_bits scm_tc16_memoized;
MAKMEMO (SCM_M_MODULE_REF, scm_cons (mod, scm_cons (var, public)))
#define MAKMEMO_MOD_SET(val, mod, var, public) \
MAKMEMO (SCM_M_MODULE_SET, scm_cons (val, scm_cons (mod, scm_cons (var, public))))
-#define MAKMEMO_PROMPT(tag, exp, handler) \
- MAKMEMO (SCM_M_PROMPT, scm_cons (tag, scm_cons (exp, handler)))
+#define MAKMEMO_CALL_WITH_PROMPT(tag, thunk, handler) \
+ MAKMEMO (SCM_M_CALL_WITH_PROMPT, scm_cons (tag, scm_cons (thunk, handler)))
/* Primitives for the evaluator */
@@ -144,7 +144,7 @@ static const char *const memoized_tags[] =
"toplevel-set!",
"module-ref",
"module-set!",
- "prompt",
+ "call-with-prompt",
};
static int
@@ -267,16 +267,25 @@ memoize (SCM exp, SCM env)
case SCM_EXPANDED_PRIMCALL:
{
- SCM proc, args;
+ SCM name, args;
+ int nargs;
- if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
- proc = MAKMEMO_TOP_REF (REF (exp, PRIMCALL, NAME));
- else
- proc = MAKMEMO_MOD_REF (list_of_guile, REF (exp, PRIMCALL, NAME),
- SCM_BOOL_F);
+ name = REF (exp, PRIMCALL, NAME);
args = memoize_exps (REF (exp, PRIMCALL, ARGS), env);
-
- return MAKMEMO_CALL (proc, scm_ilength (args), args);
+ nargs = scm_ilength (args);
+
+ if (nargs == 3
+ && scm_is_eq (name, scm_from_latin1_symbol ("call-with-prompt")))
+ return MAKMEMO_CALL_WITH_PROMPT (CAR (args),
+ CADR (args),
+ CADDR (args));
+ else if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
+ return MAKMEMO_CALL (MAKMEMO_TOP_REF (name), nargs, args);
+ else
+ return MAKMEMO_CALL (MAKMEMO_MOD_REF (list_of_guile, name,
+ SCM_BOOL_F),
+ nargs,
+ args);
}
case SCM_EXPANDED_SEQ:
@@ -525,13 +534,11 @@ static SCM m_apply (SCM proc, SCM arg, SCM rest);
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);
-static SCM m_prompt (SCM tag, SCM exp, SCM handler);
SCM_DEFINE_REST_MEMOIZER ("@apply", m_apply, 2);
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);
-SCM_DEFINE_MEMOIZER ("@prompt", m_prompt, 3);
@@ -598,16 +605,6 @@ static SCM m_dynamic_wind (SCM in, SCM expr, SCM out)
}
#undef FUNC_NAME
-static SCM m_prompt (SCM tag, SCM exp, SCM handler)
-#define FUNC_NAME "@prompt"
-{
- SCM_VALIDATE_MEMOIZED (1, tag);
- SCM_VALIDATE_MEMOIZED (2, exp);
- SCM_VALIDATE_MEMOIZED (3, handler);
- return MAKMEMO_PROMPT (tag, exp, handler);
-}
-#undef FUNC_NAME
-
@@ -768,8 +765,8 @@ unmemoize (const SCM expr)
scm_i_finite_list_copy (CADR (args)),
CADDR (args)),
unmemoize (CAR (args)));
- case SCM_M_PROMPT:
- return scm_list_4 (scm_sym_at_prompt,
+ case SCM_M_CALL_WITH_PROMPT:
+ return scm_list_4 (scm_from_latin1_symbol ("call-with-prompt"),
unmemoize (CAR (args)),
unmemoize (CADR (args)),
unmemoize (CDDR (args)));