diff options
Diffstat (limited to 'libguile/memoize.c')
-rw-r--r-- | libguile/memoize.c | 19 |
1 files changed, 18 insertions, 1 deletions
diff --git a/libguile/memoize.c b/libguile/memoize.c index 2604be9ea..393598e94 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -273,7 +273,7 @@ memoize (SCM exp, SCM env) { SCM req, rest, opt, kw, inits, vars, body, alt; SCM walk, minits, arity, new_env; - int nreq, nopt; + int nreq, nopt, ntotal; req = REF (exp, LAMBDA_CASE, REQ); rest = REF (exp, LAMBDA_CASE, REST); @@ -286,6 +286,7 @@ memoize (SCM exp, SCM env) nreq = scm_ilength (req); nopt = scm_is_pair (opt) ? scm_ilength (opt) : 0; + ntotal = scm_ilength (vars); /* The vars are the gensyms, according to the divine plan. But we need to memoize the inits within their appropriate environment, @@ -319,6 +320,22 @@ memoize (SCM exp, SCM env) minits = scm_reverse_x (minits, SCM_UNDEFINED); + if (scm_is_true (kw)) + { + /* (aok? (kw name sym) ...) -> (aok? (kw . index) ...) */ + SCM aok = CAR (kw), indices = SCM_EOL; + for (kw = CDR (kw); scm_is_pair (kw); kw = CDR (kw)) + { + SCM k; + int idx; + + k = CAR (CAR (kw)); + idx = ntotal - 1 - lookup (CADDR (CAR (kw)), new_env); + indices = scm_acons (k, SCM_I_MAKINUM (idx), indices); + } + kw = scm_cons (aok, scm_reverse_x (indices, SCM_UNDEFINED)); + } + if (scm_is_false (alt) && scm_is_false (kw) && scm_is_false (opt)) { if (scm_is_false (rest)) |