diff options
author | Andy Wingo <wingo@pobox.com> | 2010-05-12 12:17:18 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-05-13 23:37:15 +0200 |
commit | 8f9c5b589d7552d79cbafda3029986b714807a25 (patch) | |
tree | f4ba0348418a3af114994deed9c2a6e69c24f533 /libguile/memoize.c | |
parent | cc00f4474306d961bbc997bbf7fbfe6e610888da (diff) | |
download | guile-8f9c5b589d7552d79cbafda3029986b714807a25.tar.gz |
change to format of memoization lambda expressions
* libguile/memoize.c (scm_m_lambda, memoize_named_let)
(scm_memoize_lambda, unmemoize)
* libguile/eval.c (eval, prepare_boot_closure_env_for_apply)
(prepare_boot_closure_env_for_eval, boot_closure_apply):
* module/ice-9/eval.scm (primitive-eval): Change the format for memoized
lambda expressions, so as to allow, in the future, case-lambda* to be
supported by the evaluator.
Diffstat (limited to 'libguile/memoize.c')
-rw-r--r-- | libguile/memoize.c | 50 |
1 files changed, 37 insertions, 13 deletions
diff --git a/libguile/memoize.c b/libguile/memoize.c index 75b9c7e95..87375f790 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -179,8 +179,15 @@ scm_t_bits scm_tc16_memoized; MAKMEMO (SCM_M_BEGIN, exps) #define MAKMEMO_IF(test, then, else_) \ MAKMEMO (SCM_M_IF, scm_cons (test, scm_cons (then, else_))) -#define MAKMEMO_LAMBDA(nreq, rest, body) \ - MAKMEMO (SCM_M_LAMBDA, scm_cons (SCM_I_MAKINUM (nreq), scm_cons (rest, body))) +#define FIXED_ARITY(nreq) \ + scm_list_1 (SCM_I_MAKINUM (nreq)) +#define REST_ARITY(nreq, rest) \ + scm_list_2 (SCM_I_MAKINUM (nreq), rest) +/* opts := #f | (aok? (pos? kw init) ...) */ +#define FULL_ARITY(nreq, rest, opts, alt) \ + scm_list_4 (SCM_I_MAKINUM (nreq), rest, opts, alt) +#define MAKMEMO_LAMBDA(body, arity) \ + MAKMEMO (SCM_M_LAMBDA, (scm_cons (body, arity))) #define MAKMEMO_LET(inits, body) \ MAKMEMO (SCM_M_LET, scm_cons (inits, body)) #define MAKMEMO_QUOTE(exp) \ @@ -676,6 +683,7 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED) SCM formals; SCM formals_idx; SCM formal_vars = SCM_EOL; + SCM body; int nreq = 0; const SCM cdr_expr = CDR (expr); @@ -715,9 +723,13 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED) s_bad_formal, formals_idx, expr); if (scm_is_symbol (formals_idx)) formal_vars = scm_cons (formals_idx, formal_vars); - return MAKMEMO_LAMBDA (nreq, scm_symbol_p (formals_idx), - memoize_sequence (CDDR (expr), - memoize_env_extend (env, formal_vars))); + + body = memoize_sequence (CDDR (expr), memoize_env_extend (env, formal_vars)); + + if (scm_is_symbol (formals_idx)) + return MAKMEMO_LAMBDA (body, REST_ARITY (nreq, SCM_BOOL_T)); + else + return MAKMEMO_LAMBDA (body, FIXED_ARITY (nreq)); } /* Check if the format of the bindings is ((<symbol> <init-form>) ...). */ @@ -796,10 +808,10 @@ memoize_named_let (const SCM expr, SCM env) MAKMEMO_BEGIN (scm_list_2 (MAKMEMO_LEX_SET (0, - MAKMEMO_LAMBDA - (nreq, SCM_BOOL_F, - memoize_sequence (CDDDR (expr), - memoize_env_extend (env, rvariables)))), + MAKMEMO_LAMBDA (memoize_sequence + (CDDDR (expr), + memoize_env_extend (env, rvariables)), + FIXED_ARITY (nreq))), MAKMEMO_CALL (MAKMEMO_LEX_REF (0), nreq, memoize_exprs (inits, env))))); @@ -1118,7 +1130,7 @@ SCM_DEFINE (scm_memoize_lambda, "memoize-lambda", 3, 0, 0, { SCM_VALIDATE_BOOL (2, rest); SCM_VALIDATE_MEMOIZED (3, body); - return MAKMEMO_LAMBDA (scm_to_uint16 (nreq), rest, body); + return MAKMEMO_LAMBDA (body, REST_ARITY (scm_to_uint16 (nreq), rest)); } #undef FUNC_NAME @@ -1323,9 +1335,21 @@ unmemoize (const SCM expr) return scm_list_4 (scm_sym_if, unmemoize (scm_car (args)), unmemoize (scm_cadr (args)), unmemoize (scm_cddr (args))); case SCM_M_LAMBDA: - return scm_list_3 (scm_sym_lambda, - scm_make_list (CAR (args), sym_placeholder), - unmemoize (CDDR (args))); + if (scm_is_null (CDDR (args))) + return scm_list_3 (scm_sym_lambda, + scm_make_list (CADR (args), sym_placeholder), + unmemoize (CAR (args))); + else if (scm_is_null (CDDDR (args))) + { + SCM formals = scm_make_list (CADR (args), sym_placeholder); + return scm_list_3 (scm_sym_lambda, + scm_is_true (CADDR (args)) + ? scm_cons_star (sym_placeholder, formals) + : formals, + unmemoize (CAR (args))); + } + else + abort (); case SCM_M_LET: return scm_list_3 (scm_sym_let, unmemoize_bindings (CAR (args)), |