summaryrefslogtreecommitdiff
path: root/libguile/memoize.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-06-17 11:12:58 +0200
committerAndy Wingo <wingo@pobox.com>2010-06-17 13:43:26 +0200
commit826373a25d71173f0f5045c61dc5854910cf1a80 (patch)
treea851907357f7b01926a42b3c97d2744a8571915b /libguile/memoize.c
parentfb6e61ca21b397308474a6a553f7d502d0113251 (diff)
downloadguile-826373a25d71173f0f5045c61dc5854910cf1a80.tar.gz
psyntax, primitive expander, and memoizer support for letrec*
* libguile/expand.c (expand_letrec_helper): Factor out common code. (expand_letrec): Use expand_letrec_helper. (expand_letrec_star): New primitive syntax: letrec*. * libguile/memoize.c (memoize): Add memoizer support for in-order letrec (letrec*). * module/ice-9/psyntax.scm (build-letrec): Another arg, `in-order?'. (chi-body): Adapt to build-letrec change. We don't yet use letrec* for internal definitions. (letrec): Adapt to build-letrec change. (letrec*): New expander. * module/ice-9/psyntax-pp.scm: Regenerated.
Diffstat (limited to 'libguile/memoize.c')
-rw-r--r--libguile/memoize.c47
1 files changed, 32 insertions, 15 deletions
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 977b86933..44c0101f8 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -374,33 +374,50 @@ memoize (SCM exp, SCM env)
case SCM_EXPANDED_LETREC:
{
- SCM vars, exps, body, undefs, inits, sets, new_env;
- int i, nvars;
+ SCM vars, exps, body, undefs, new_env;
+ int i, nvars, in_order_p;
vars = REF (exp, LETREC, GENSYMS);
exps = REF (exp, LETREC, VALS);
body = REF (exp, LETREC, BODY);
+ in_order_p = scm_is_true (REF (exp, LETREC, IN_ORDER_P));
nvars = i = scm_ilength (vars);
- inits = undefs = sets = SCM_EOL;
+ undefs = SCM_EOL;
new_env = env;
- for (; scm_is_pair (vars); vars = CDR (vars), i--)
+ for (; scm_is_pair (vars); vars = CDR (vars))
{
new_env = scm_cons (CAR (vars), new_env);
undefs = scm_cons (MAKMEMO_QUOTE (SCM_UNDEFINED), undefs);
- sets = scm_cons (MAKMEMO_LEX_SET ((i-1) + nvars,
- MAKMEMO_LEX_REF (i-1)),
- sets);
}
- for (; scm_is_pair (exps); exps = CDR (exps))
- inits = scm_cons (memoize (CAR (exps), new_env), inits);
- inits = scm_reverse_x (inits, SCM_UNDEFINED);
-
- return MAKMEMO_LET
- (undefs,
- MAKMEMO_BEGIN (scm_list_2 (MAKMEMO_LET (inits, MAKMEMO_BEGIN (sets)),
- memoize (body, new_env))));
+ if (in_order_p)
+ {
+ SCM body_exps = SCM_EOL;
+ for (; scm_is_pair (exps); exps = CDR (exps), i--)
+ body_exps = scm_cons (MAKMEMO_LEX_SET (i-1,
+ memoize (CAR (exps), new_env)),
+ body_exps);
+ body_exps = scm_cons (memoize (body, new_env), body_exps);
+ body_exps = scm_reverse_x (body_exps, SCM_UNDEFINED);
+ return MAKMEMO_LET (undefs, MAKMEMO_BEGIN (body_exps));
+ }
+ else
+ {
+ SCM sets = SCM_EOL, inits = SCM_EOL;
+ for (; scm_is_pair (exps); exps = CDR (exps), i--)
+ {
+ sets = scm_cons (MAKMEMO_LEX_SET ((i-1) + nvars,
+ MAKMEMO_LEX_REF (i-1)),
+ sets);
+ inits = scm_cons (memoize (CAR (exps), new_env), inits);
+ }
+ inits = scm_reverse_x (inits, SCM_UNDEFINED);
+ return MAKMEMO_LET
+ (undefs,
+ MAKMEMO_BEGIN (scm_list_2 (MAKMEMO_LET (inits, MAKMEMO_BEGIN (sets)),
+ memoize (body, new_env))));
+ }
}
case SCM_EXPANDED_DYNLET: