diff options
author | Andy Wingo <wingo@pobox.com> | 2014-12-07 09:34:22 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-12-07 09:34:22 +0100 |
commit | a3cae847d0e6c77494c7cf5f395e8234e3b9b5cf (patch) | |
tree | 08c3bf9fb8bf9c6c7180e3a0494e7bc71f51f951 /libguile/memoize.c | |
parent | 99fb07e19bf47b929fbd7e4574f96ea0bff4e641 (diff) | |
download | guile-a3cae847d0e6c77494c7cf5f395e8234e3b9b5cf.tar.gz |
Closure conversion in evaluator
* libguile/memoize.c (MAKMEMO_CAPTURE_ENV, push_nested_link)
(push_flat_link, env_link_is_flat, env_link_vars)
(env_link_add_flat_var, lookup, capture_flat_env, memoize): Capture
flat environments around closures.
Diffstat (limited to 'libguile/memoize.c')
-rw-r--r-- | libguile/memoize.c | 123 |
1 files changed, 110 insertions, 13 deletions
diff --git a/libguile/memoize.c b/libguile/memoize.c index 3923ee334..8ebc1a02c 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, - * 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 + * 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -125,6 +125,8 @@ scm_t_bits scm_tc16_memoized; #define MAKMEMO_LAMBDA(body, arity, meta) \ MAKMEMO (SCM_M_LAMBDA, \ scm_cons (body, scm_cons (meta, arity))) +#define MAKMEMO_CAPTURE_ENV(vars, body) \ + MAKMEMO (SCM_M_CAPTURE_ENV, scm_cons (vars, body)) #define MAKMEMO_LET(inits, body) \ MAKMEMO (SCM_M_LET, scm_cons (inits, body)) #define MAKMEMO_QUOTE(exp) \ @@ -187,6 +189,31 @@ static const char *const memoized_tags[] = +/* Memoization-time environments mirror the structure of eval-time + environments. Each link in the chain at memoization-time corresponds + to a link at eval-time. + + env := module | (link, env) + module := #f | #t + link := flat-link . nested-link + flat-link := (#t . ((var . pos) ...)) + nested-link := (#f . #(var ...)) + + A module of #f indicates that the current module has not yet been + captured. Memoizing a capture-module expression will capture the + module. + + Flat environments copy the values for a set of free variables into a + flat environment, via the capture-env expression. During memoization + a flat link collects the values of free variables, along with their + resolved outer locations. We are able to copy values because the + incoming expression has already been assignment-converted. Flat + environments prevent closures from hanging on to too much memory. + + Nested environments have a rib of "let" bindings, and link to an + outer environment. +*/ + static int try_lookup_rib (SCM x, SCM rib) { @@ -213,19 +240,86 @@ make_pos (int depth, int width) } static SCM +push_nested_link (SCM vars, SCM env) +{ + return scm_acons (SCM_BOOL_F, vars, env); +} + +static SCM +push_flat_link (SCM env) +{ + return scm_acons (SCM_BOOL_T, SCM_EOL, env); +} + +static int +env_link_is_flat (SCM env_link) +{ + return scm_is_true (CAR (env_link)); +} + +static SCM +env_link_vars (SCM env_link) +{ + return CDR (env_link); +} + +static void +env_link_add_flat_var (SCM env_link, SCM var, SCM pos) +{ + SCM vars = env_link_vars (env_link); + if (scm_is_false (scm_assq (var, vars))) + scm_set_cdr_x (env_link, scm_acons (var, pos, vars)); +} + +static SCM lookup (SCM x, SCM env) { int d = 0; for (; scm_is_pair (env); env = CDR (env), d++) { - int w = try_lookup_rib (x, CAR (env)); - if (w < 0) - continue; - return make_pos (d, w); + SCM link = CAR (env); + if (env_link_is_flat (link)) + { + int w; + SCM vars; + + for (vars = env_link_vars (link), w = scm_ilength (vars) - 1; + scm_is_pair (vars); + vars = CDR (vars), w--) + if (scm_is_eq (x, (CAAR (vars)))) + return make_pos (d, w); + + env_link_add_flat_var (link, x, lookup (x, CDR (env))); + return make_pos (d, scm_ilength (env_link_vars (link)) - 1); + } + else + { + int w = try_lookup_rib (x, env_link_vars (link)); + if (w < 0) + continue; + return make_pos (d, w); + } } abort (); } +static SCM +capture_flat_env (SCM lambda, SCM env) +{ + int nenv; + SCM vars, link, locs; + + link = CAR (env); + vars = env_link_vars (link); + nenv = scm_ilength (vars); + locs = scm_c_make_vector (nenv, SCM_BOOL_F); + + for (; scm_is_pair (vars); vars = CDR (vars)) + scm_c_vector_set_x (locs, --nenv, CDAR (vars)); + + return MAKMEMO_CAPTURE_ENV (locs, lambda); +} + /* Abbreviate SCM_EXPANDED_REF. Copied because I'm not sure about symbol pasting */ #define REF(x,type,field) \ (scm_struct_ref (x, SCM_I_MAKINUM (SCM_EXPANDED_##type##_##field))) @@ -386,11 +480,12 @@ memoize (SCM exp, SCM env) case SCM_EXPANDED_LAMBDA: /* The body will be a lambda-case or #f. */ { - SCM meta, body, proc; + SCM meta, body, proc, new_env; meta = REF (exp, LAMBDA, META); - body = REF (exp, LAMBDA, BODY); + new_env = push_flat_link (capture_env (env)); + if (scm_is_false (body)) /* Give a body to case-lambda with no clauses. */ proc = MAKMEMO_LAMBDA @@ -409,17 +504,18 @@ memoize (SCM exp, SCM env) meta); else { - proc = memoize (body, capture_env (env)); + proc = memoize (body, new_env); SCM_SETCAR (SCM_CDR (SCM_MEMOIZED_ARGS (proc)), meta); } - return maybe_makmemo_capture_module (proc, env); + return maybe_makmemo_capture_module (capture_flat_env (proc, new_env), + env); } case SCM_EXPANDED_LAMBDA_CASE: { SCM req, rest, opt, kw, inits, vars, body, alt; - SCM unbound, arity, rib; + SCM unbound, arity, rib, new_env; int nreq, nopt, ninits; req = REF (exp, LAMBDA_CASE, REQ); @@ -439,6 +535,7 @@ memoize (SCM exp, SCM env) "unbound" token. */ unbound = ninits ? REF (CAR (inits), CONST, EXP) : SCM_BOOL_F; rib = scm_vector (vars); + new_env = push_nested_link (rib, env); if (scm_is_true (kw)) { @@ -470,8 +567,8 @@ memoize (SCM exp, SCM env) arity = FULL_ARITY (nreq, rest, nopt, kw, ninits, unbound, SCM_BOOL_F); - return MAKMEMO_LAMBDA (memoize (body, scm_cons (rib, env)), arity, - SCM_BOOL_F /* meta, filled in later */); + return MAKMEMO_LAMBDA (memoize (body, new_env), arity, + SCM_BOOL_F /* meta, filled in later */); } case SCM_EXPANDED_LET: @@ -486,7 +583,7 @@ memoize (SCM exp, SCM env) varsv = scm_vector (vars); inits = scm_c_make_vector (VECTOR_LENGTH (varsv), SCM_BOOL_F); - new_env = scm_cons (varsv, capture_env (env)); + new_env = push_nested_link (varsv, capture_env (env)); for (i = 0; scm_is_pair (exps); exps = CDR (exps), i++) VECTOR_SET (inits, i, memoize (CAR (exps), env)); |