diff options
author | Andy Wingo <wingo@pobox.com> | 2013-10-31 22:16:10 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-10-31 22:16:10 +0100 |
commit | ef47c4229c9c19db56bb0c123eba01c71c4a2011 (patch) | |
tree | 4e07c00197b07df63824f4e4a83875929a74a144 /libguile/memoize.c | |
parent | 3e248c70e3be268b6ad71c9eee9895519ab0495f (diff) | |
download | guile-ef47c4229c9c19db56bb0c123eba01c71c4a2011.tar.gz |
Be smarter about capturing the environment for memoized code
* libguile/memoize.h (SCM_M_CAPTURE_MODULE)
* libguile/memoize.c (MAKMEMO_CAPTURE_MODULE, capture_env):
(maybe_makmemo_capture_module, memoize): Determine when to capture the
module on the environment chain at compile-time, instead of at
runtime. Introduces a new memoized expression type, capture-module.
(scm_memoized_expression): Start memoizing with #f as the
environment.
(unmemoize): Add unmemoizer.
(scm_memoize_variable_access_x): Cope with #f as module, and treat as
the root module (captured before modules were booted).
* libguile/eval.c (eval):
* module/ice-9/eval.scm (primitive-eval): Adapt.
Diffstat (limited to 'libguile/memoize.c')
-rw-r--r-- | libguile/memoize.c | 67 |
1 files changed, 52 insertions, 15 deletions
diff --git a/libguile/memoize.c b/libguile/memoize.c index 6eb36d437..5c7129feb 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -131,6 +131,8 @@ scm_t_bits scm_tc16_memoized; MAKMEMO (SCM_M_QUOTE, exp) #define MAKMEMO_DEFINE(var, val) \ MAKMEMO (SCM_M_DEFINE, scm_cons (var, val)) +#define MAKMEMO_CAPTURE_MODULE(exp) \ + MAKMEMO (SCM_M_CAPTURE_MODULE, exp) #define MAKMEMO_APPLY(proc, args)\ MAKMEMO (SCM_M_APPLY, scm_list_2 (proc, args)) #define MAKMEMO_CONT(proc) \ @@ -166,6 +168,7 @@ static const char *const memoized_tags[] = "let", "quote", "define", + "capture-module", "apply", "call/cc", "call-with-values", @@ -240,6 +243,22 @@ memoize_exps (SCM exps, SCM env) } static SCM +capture_env (SCM env) +{ + if (scm_is_false (env)) + return SCM_BOOL_T; + return env; +} + +static SCM +maybe_makmemo_capture_module (SCM exp, SCM env) +{ + if (scm_is_false (env)) + return MAKMEMO_CAPTURE_MODULE (exp); + return exp; +} + +static SCM memoize (SCM exp, SCM env) { if (!SCM_EXPANDED_P (exp)) @@ -255,7 +274,9 @@ memoize (SCM exp, SCM env) case SCM_EXPANDED_PRIMITIVE_REF: if (scm_is_eq (scm_current_module (), scm_the_root_module ())) - return MAKMEMO_TOP_REF (REF (exp, PRIMITIVE_REF, NAME)); + return maybe_makmemo_capture_module + (MAKMEMO_TOP_REF (REF (exp, PRIMITIVE_REF, NAME)), + env); else return MAKMEMO_MOD_REF (list_of_guile, REF (exp, PRIMITIVE_REF, NAME), SCM_BOOL_F); @@ -279,11 +300,15 @@ memoize (SCM exp, SCM env) REF (exp, MODULE_SET, PUBLIC)); case SCM_EXPANDED_TOPLEVEL_REF: - return MAKMEMO_TOP_REF (REF (exp, TOPLEVEL_REF, NAME)); + return maybe_makmemo_capture_module + (MAKMEMO_TOP_REF (REF (exp, TOPLEVEL_REF, NAME)), env); case SCM_EXPANDED_TOPLEVEL_SET: - return MAKMEMO_TOP_SET (REF (exp, TOPLEVEL_SET, NAME), - memoize (REF (exp, TOPLEVEL_SET, EXP), env)); + return maybe_makmemo_capture_module + (MAKMEMO_TOP_SET (REF (exp, TOPLEVEL_SET, NAME), + memoize (REF (exp, TOPLEVEL_SET, EXP), + capture_env (env))), + env); case SCM_EXPANDED_TOPLEVEL_DEFINE: return MAKMEMO_DEFINE (REF (exp, TOPLEVEL_DEFINE, NAME), @@ -343,7 +368,9 @@ memoize (SCM exp, SCM env) && scm_is_eq (name, scm_from_latin1_symbol ("pop-fluid"))) return MAKMEMO_CALL (MAKMEMO_QUOTE (pop_fluid), 0, SCM_EOL); else if (scm_is_eq (scm_current_module (), scm_the_root_module ())) - return MAKMEMO_CALL (MAKMEMO_TOP_REF (name), nargs, args); + return MAKMEMO_CALL (maybe_makmemo_capture_module + (MAKMEMO_TOP_REF (name), env), + nargs, args); else return MAKMEMO_CALL (MAKMEMO_MOD_REF (list_of_guile, name, SCM_BOOL_F), @@ -381,11 +408,11 @@ memoize (SCM exp, SCM env) meta); else { - proc = memoize (body, env); + proc = memoize (body, capture_env (env)); SCM_SETCAR (SCM_CDR (SCM_MEMOIZED_ARGS (proc)), meta); } - return proc; + return maybe_makmemo_capture_module (proc, env); } case SCM_EXPANDED_LAMBDA_CASE: @@ -462,11 +489,12 @@ 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, env); + new_env = scm_cons (varsv, capture_env (env)); for (i = 0; scm_is_pair (exps); exps = CDR (exps), i++) VECTOR_SET (inits, i, memoize (CAR (exps), env)); - return MAKMEMO_LET (inits, memoize (body, new_env)); + return maybe_makmemo_capture_module + (MAKMEMO_LET (inits, memoize (body, new_env)), env); } case SCM_EXPANDED_LETREC: @@ -484,7 +512,7 @@ memoize (SCM exp, SCM env) expsv = scm_vector (exps); undefs = scm_c_make_vector (nvars, MAKMEMO_QUOTE (SCM_UNDEFINED)); - new_env = scm_cons (varsv, env); + new_env = scm_cons (varsv, capture_env (env)); if (in_order_p) { @@ -495,7 +523,8 @@ memoize (SCM exp, SCM env) body_exps = MAKMEMO_SEQ (MAKMEMO_LEX_SET (make_pos (0, i), init), body_exps); } - return MAKMEMO_LET (undefs, body_exps); + return maybe_makmemo_capture_module + (MAKMEMO_LET (undefs, body_exps), env); } else { @@ -518,9 +547,11 @@ memoize (SCM exp, SCM env) if (scm_is_false (sets)) return memoize (body, env); - return MAKMEMO_LET (undefs, - MAKMEMO_SEQ (MAKMEMO_LET (inits, sets), - memoize (body, new_env))); + return maybe_makmemo_capture_module + (MAKMEMO_LET (undefs, + MAKMEMO_SEQ (MAKMEMO_LET (inits, sets), + memoize (body, new_env))), + env); } } @@ -538,7 +569,7 @@ SCM_DEFINE (scm_memoize_expression, "memoize-expression", 1, 0, 0, #define FUNC_NAME s_scm_memoize_expression { SCM_ASSERT_TYPE (SCM_EXPANDED_P (exp), exp, 1, FUNC_NAME, "expanded"); - return memoize (exp, scm_current_module ()); + return memoize (exp, SCM_BOOL_F); } #undef FUNC_NAME @@ -612,6 +643,9 @@ unmemoize (const SCM expr) unmemoize (CAR (args)), unmemoize (CDR (args))); case SCM_M_DEFINE: return scm_list_3 (scm_sym_define, CAR (args), unmemoize (CDR (args))); + case SCM_M_CAPTURE_MODULE: + return scm_list_2 (scm_from_latin1_symbol ("capture-module"), + unmemoize (args)); case SCM_M_IF: return scm_list_4 (scm_sym_if, unmemoize (scm_car (args)), unmemoize (scm_cadr (args)), unmemoize (scm_cddr (args))); @@ -735,6 +769,9 @@ SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0, { SCM mx = SCM_MEMOIZED_ARGS (m); + if (scm_is_false (mod)) + mod = scm_the_root_module (); + switch (SCM_MEMOIZED_TAG (m)) { case SCM_M_TOPLEVEL_REF: |