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/eval.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/eval.c')
-rw-r--r-- | libguile/eval.c | 134 |
1 files changed, 74 insertions, 60 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index 8e6e3c474..fca599f61 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -106,10 +106,19 @@ static scm_t_bits scm_tc16_boot_closure; #define BOOT_CLOSURE_P(obj) SCM_TYP16_PREDICATE (scm_tc16_boot_closure, (obj)) #define BOOT_CLOSURE_CODE(x) SCM_SMOB_OBJECT (x) #define BOOT_CLOSURE_ENV(x) SCM_SMOB_OBJECT_2 (x) -#define BOOT_CLOSURE_NUM_REQUIRED_ARGS(x) SCM_I_INUM (CAR (BOOT_CLOSURE_CODE (x))) -#define BOOT_CLOSURE_HAS_REST_ARGS(x) scm_is_true (CADR (BOOT_CLOSURE_CODE (x))) -#define BOOT_CLOSURE_BODY(x) CDDR (BOOT_CLOSURE_CODE (x)) - +#define BOOT_CLOSURE_BODY(x) CAR (BOOT_CLOSURE_CODE (x)) +#define BOOT_CLOSURE_NUM_REQUIRED_ARGS(x) SCM_I_INUM (CADR (BOOT_CLOSURE_CODE (x))) +#define BOOT_CLOSURE_IS_FIXED(x) scm_is_null (CDDR (BOOT_CLOSURE_CODE (x))) +/* NB: One may only call the following accessors if the closure is not FIXED. */ +#define BOOT_CLOSURE_HAS_REST_ARGS(x) scm_is_true (CADDR (BOOT_CLOSURE_CODE (x))) +#define BOOT_CLOSURE_IS_REST(x) scm_is_null (CDDDR (BOOT_CLOSURE_CODE (x))) +/* NB: One may only call the following accessors if the closure is not REST. */ +#define BOOT_CLOSURE_IS_FULL(x) (1) +#define BOOT_CLOSURE_OPT(x) CAR (CDDDR (BOOT_CLOSURE_CODE (x))) +#define BOOT_CLOSURE_ALT(x) CADR (CDDDR (BOOT_CLOSURE_CODE (x))) +static SCM prepare_boot_closure_env_for_apply (SCM proc, SCM args); +static SCM prepare_boot_closure_env_for_eval (SCM proc, unsigned int argc, + SCM exps, SCM env); #define CAR(x) SCM_CAR(x) @@ -238,25 +247,8 @@ eval (SCM x, SCM env) * ARGS is the list of arguments. */ if (BOOT_CLOSURE_P (proc)) { - int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc); - SCM new_env = BOOT_CLOSURE_ENV (proc); - if (BOOT_CLOSURE_HAS_REST_ARGS (proc)) - { - if (SCM_UNLIKELY (scm_ilength (args) < nreq)) - scm_wrong_num_args (proc); - for (; nreq; nreq--, args = CDR (args)) - new_env = scm_cons (CAR (args), new_env); - new_env = scm_cons (args, new_env); - } - else - { - if (SCM_UNLIKELY (scm_ilength (args) != nreq)) - scm_wrong_num_args (proc); - for (; scm_is_pair (args); args = CDR (args)) - new_env = scm_cons (CAR (args), new_env); - } x = BOOT_CLOSURE_BODY (proc); - env = new_env; + env = prepare_boot_closure_env_for_apply (proc, args); goto loop; } else @@ -270,31 +262,8 @@ eval (SCM x, SCM env) if (BOOT_CLOSURE_P (proc)) { - int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc); - SCM new_env = BOOT_CLOSURE_ENV (proc); - if (BOOT_CLOSURE_HAS_REST_ARGS (proc)) - { - if (SCM_UNLIKELY (argc < nreq)) - scm_wrong_num_args (proc); - for (; nreq; nreq--, mx = CDR (mx)) - new_env = scm_cons (eval (CAR (mx), env), new_env); - { - SCM rest = SCM_EOL; - for (; scm_is_pair (mx); mx = CDR (mx)) - rest = scm_cons (eval (CAR (mx), env), rest); - new_env = scm_cons (scm_reverse (rest), - new_env); - } - } - else - { - for (; scm_is_pair (mx); mx = CDR (mx), nreq--) - new_env = scm_cons (eval (CAR (mx), env), new_env); - if (SCM_UNLIKELY (nreq != 0)) - scm_wrong_num_args (proc); - } x = BOOT_CLOSURE_BODY (proc); - env = new_env; + env = prepare_boot_closure_env_for_eval (proc, argc, mx, env); goto loop; } else @@ -908,28 +877,73 @@ scm_apply (SCM proc, SCM arg1, SCM args) return scm_vm_apply (scm_the_vm (), proc, args); } - static SCM -boot_closure_apply (SCM closure, SCM args) +prepare_boot_closure_env_for_apply (SCM proc, SCM args) { - int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (closure); - SCM new_env = BOOT_CLOSURE_ENV (closure); - if (BOOT_CLOSURE_HAS_REST_ARGS (closure)) + int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc); + SCM env = BOOT_CLOSURE_ENV (proc); + if (BOOT_CLOSURE_IS_FIXED (proc) + || (BOOT_CLOSURE_IS_REST (proc) + && !BOOT_CLOSURE_HAS_REST_ARGS (proc))) + { + if (SCM_UNLIKELY (scm_ilength (args) != nreq)) + scm_wrong_num_args (proc); + for (; scm_is_pair (args); args = CDR (args)) + env = scm_cons (CAR (args), env); + } + else if (BOOT_CLOSURE_IS_REST (proc)) { if (SCM_UNLIKELY (scm_ilength (args) < nreq)) - scm_wrong_num_args (closure); + scm_wrong_num_args (proc); for (; nreq; nreq--, args = CDR (args)) - new_env = scm_cons (CAR (args), new_env); - new_env = scm_cons (args, new_env); + env = scm_cons (CAR (args), env); + env = scm_cons (args, env); } else + abort (); + + return env; +} + +static SCM +prepare_boot_closure_env_for_eval (SCM proc, unsigned int argc, + SCM exps, SCM env) +{ + int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc); + SCM new_env = BOOT_CLOSURE_ENV (proc); + if (BOOT_CLOSURE_IS_FIXED (proc) + || (BOOT_CLOSURE_IS_REST (proc) + && !BOOT_CLOSURE_HAS_REST_ARGS (proc))) { - if (SCM_UNLIKELY (scm_ilength (args) != nreq)) - scm_wrong_num_args (closure); - for (; scm_is_pair (args); args = CDR (args)) - new_env = scm_cons (CAR (args), new_env); + for (; scm_is_pair (exps); exps = CDR (exps), nreq--) + new_env = scm_cons (eval (CAR (exps), env), new_env); + if (SCM_UNLIKELY (nreq != 0)) + scm_wrong_num_args (proc); } - return eval (BOOT_CLOSURE_BODY (closure), new_env); + else if (BOOT_CLOSURE_IS_REST (proc)) + { + if (SCM_UNLIKELY (argc < nreq)) + scm_wrong_num_args (proc); + for (; nreq; nreq--, exps = CDR (exps)) + new_env = scm_cons (eval (CAR (exps), env), new_env); + { + SCM rest = SCM_EOL; + for (; scm_is_pair (exps); exps = CDR (exps)) + rest = scm_cons (eval (CAR (exps), env), rest); + new_env = scm_cons (scm_reverse (rest), + new_env); + } + } + else + abort (); + return new_env; +} + +static SCM +boot_closure_apply (SCM closure, SCM args) +{ + return eval (BOOT_CLOSURE_BODY (closure), + prepare_boot_closure_env_for_apply (closure, args)); } static int @@ -941,7 +955,7 @@ boot_closure_print (SCM closure, SCM port, scm_print_state *pstate) scm_putc (' ', port); args = scm_make_list (scm_from_int (BOOT_CLOSURE_NUM_REQUIRED_ARGS (closure)), scm_from_locale_symbol ("_")); - if (BOOT_CLOSURE_HAS_REST_ARGS (closure)) + if (!BOOT_CLOSURE_IS_FIXED (closure) && BOOT_CLOSURE_HAS_REST_ARGS (closure)) args = scm_cons_star (scm_from_locale_symbol ("_"), args); scm_display (args, port); scm_putc ('>', port); |