mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00
Code Activity

psyntax, primitive expander, and memoizer support for letrec*

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2010-06-17 11:12:58 +02:00
parent fb6e61ca21
commit 826373a25d
4 changed files with 3316 additions and 3180 deletions
Download patch file Download diff file Expand all files Collapse all files

47
libguile/memoize.c
View file

@ -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: