diff options
author | Andy Wingo <wingo@pobox.com> | 2013-06-25 22:36:08 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-06-27 11:31:21 +0200 |
commit | 1773bc7dd5f4c8a1d13c7cf2015f3a04c9299eeb (patch) | |
tree | 3a645fa1af56c5572d7d0933792930592e84ab6f /libguile/memoize.c | |
parent | 385049949aa52b8578334d073b2c63291a5d5274 (diff) | |
download | guile-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.c | 47 |
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))); |