summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/expand.c17
-rw-r--r--libguile/memoize.c47
2 files changed, 47 insertions, 17 deletions
diff --git a/libguile/expand.c b/libguile/expand.c
index 62e3acfb6..bdecd80d8 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -163,6 +163,7 @@ SCM_SYNTAX ("set!", expand_set_x);
SCM_SYNTAX ("and", expand_and);
SCM_SYNTAX ("cond", expand_cond);
SCM_SYNTAX ("letrec", expand_letrec);
+SCM_SYNTAX ("letrec*", expand_letrec_star);
SCM_SYNTAX ("let*", expand_letstar);
SCM_SYNTAX ("or", expand_or);
SCM_SYNTAX ("lambda*", expand_lambda_star);
@@ -1030,7 +1031,7 @@ expand_let (SCM expr, SCM env)
}
static SCM
-expand_letrec (SCM expr, SCM env)
+expand_letrec_helper (SCM expr, SCM env, SCM in_order_p)
{
SCM bindings;
@@ -1048,13 +1049,25 @@ expand_letrec (SCM expr, SCM env)
SCM var_names, var_syms, inits;
transform_bindings (bindings, expr, &var_names, &var_syms, &inits);
env = expand_env_extend (env, var_names, var_syms);
- return LETREC (SCM_BOOL_F, SCM_BOOL_F,
+ return LETREC (SCM_BOOL_F, in_order_p,
var_names, var_syms, expand_exprs (inits, env),
expand_sequence (CDDR (expr), env));
}
}
static SCM
+expand_letrec (SCM expr, SCM env)
+{
+ return expand_letrec_helper (expr, env, SCM_BOOL_F);
+}
+
+static SCM
+expand_letrec_star (SCM expr, SCM env)
+{
+ return expand_letrec_helper (expr, env, SCM_BOOL_T);
+}
+
+static SCM
expand_letstar_clause (SCM bindings, SCM body, SCM env SCM_UNUSED)
{
if (scm_is_null (bindings))
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: