mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

remove @apply memoizer

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2013-06-27 11:25:34 +02:00
parent 1773bc7dd5
commit 39caffe79b
11 changed files with 46 additions and 79 deletions
Download patch file Download diff file Expand all files Collapse all files

49
libguile/memoize.c
View file

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