diff options
author | Andy Wingo <wingo@pobox.com> | 2013-06-27 11:25:34 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-06-27 22:02:35 +0200 |
commit | 39caffe79b3d159590b5ce1ccf8fe28c3d5cfdc6 (patch) | |
tree | 94994ed36aed8426e5287953396350e92db1b5dc /libguile/memoize.c | |
parent | 1773bc7dd5f4c8a1d13c7cf2015f3a04c9299eeb (diff) | |
download | guile-39caffe79b3d159590b5ce1ccf8fe28c3d5cfdc6.tar.gz |
remove @apply memoizer
* libguile/memoize.c (memoize): Recognize a primcall to 'apply as
SCM_M_APPLY.
(@apply): Remove @apply memoizer.
(unmemoize): Unmemoize using "apply", not "@apply".
* libguile/memoize.h:
* libguile/expand.c (scm_sym_atapply): Remove.
* module/ice-9/boot-9.scm (apply): Re-implement using apply primcall.
Use case-lambda, so as to give an appropriate minimum arity.
* module/language/tree-il/compile-glil.scm (flatten-lambda-case):
Compile a primcall of "apply" specially, not "@apply".
* module/language/tree-il/peval.scm (peval): Match primcalls to "apply",
not "@apply". Residualize "apply" primcalls.
* module/language/tree-il/primitives.scm (*interesting-primitive-names*):
(*multiply-valued-primitives*): Remove @apply, and apply primitive
expander.
* test-suite/tests/peval.test:
* test-suite/tests/tree-il.test: Update tests to expect residualized
"apply".
* test-suite/tests/procprop.test ("procedure-arity"): Update test for
better apply arity.
* test-suite/tests/strings.test ("string"): Update expected error.
Diffstat (limited to 'libguile/memoize.c')
-rw-r--r-- | libguile/memoize.c | 49 |
1 files changed, 5 insertions, 44 deletions
diff --git a/libguile/memoize.c b/libguile/memoize.c index f4a4c9ef7..12e670ae1 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -279,6 +279,9 @@ memoize (SCM exp, SCM env) return MAKMEMO_CALL_WITH_PROMPT (CAR (args), CADR (args), CADDR (args)); + else if (nargs == 2 + && scm_is_eq (name, scm_from_latin1_symbol ("apply"))) + return MAKMEMO_APPLY (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 @@ -524,18 +527,10 @@ 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))) -#define SCM_MAKE_REST_MEMOIZER(STR, MEMOIZER, N) \ - (scm_cell (scm_tc16_memoizer, \ - SCM_UNPACK ((scm_c_make_gsubr (STR, N, 0, 1, MEMOIZER))))) -#define SCM_DEFINE_REST_MEMOIZER(STR, MEMOIZER, N) \ -SCM_SNARF_INIT(scm_c_define (STR, SCM_MAKE_REST_MEMOIZER (STR, MEMOIZER, N))) - -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); -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); @@ -543,41 +538,6 @@ SCM_DEFINE_MEMOIZER ("@dynamic-wind", m_dynamic_wind, 3); -static SCM m_apply (SCM proc, SCM arg, SCM rest) -#define FUNC_NAME "@apply" -{ - long len; - - SCM_VALIDATE_MEMOIZED (1, proc); - SCM_VALIDATE_MEMOIZED (2, arg); - len = scm_ilength (rest); - if (len < 0) - abort (); - else if (len == 0) - return MAKMEMO_APPLY (proc, arg); - else - { - SCM tail; - - rest = scm_reverse (rest); - tail = scm_car (rest); - rest = scm_cdr (rest); - len--; - - while (scm_is_pair (rest)) - { - tail = MAKMEMO_CALL (MAKMEMO_MOD_REF (scm_list_1 (scm_from_latin1_symbol ("guile")), - scm_from_latin1_symbol ("cons"), - SCM_BOOL_F), - 2, - scm_list_2 (scm_car (rest), tail)); - rest = scm_cdr (rest); - } - return MAKMEMO_APPLY (proc, tail); - } -} -#undef FUNC_NAME - static SCM m_call_cc (SCM proc) #define FUNC_NAME "@call-with-current-continuation" { @@ -666,7 +626,8 @@ unmemoize (const SCM expr) switch (SCM_MEMOIZED_TAG (expr)) { case SCM_M_APPLY: - return scm_cons (scm_sym_atapply, unmemoize_exprs (args)); + return scm_cons (scm_from_latin1_symbol ("apply"), + unmemoize_exprs (args)); case SCM_M_SEQ: return scm_list_3 (scm_sym_begin, unmemoize (CAR (args)), unmemoize (CDR (args))); |