diff options
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/expand.c | 17 | ||||
-rw-r--r-- | libguile/memoize.c | 47 |
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: |