diff options
author | Andy Wingo <wingo@pobox.com> | 2014-12-05 16:54:35 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-12-05 16:54:35 +0100 |
commit | cfdc8416a2540e43504a021d4f7c44c7d21a668d (patch) | |
tree | 375bf90b132efb6668d0084234eb66ef54c92e38 /libguile/memoize.c | |
parent | 7974c57937104b0617d93fa492d3bd323b053f20 (diff) | |
download | guile-cfdc8416a2540e43504a021d4f7c44c7d21a668d.tar.gz |
Simplify the interpreter for trivial inits and no letrec
* libguile/memoize.c (FULL_ARITY): Serialize "ninits" and the unbound
value instead of the init list.
(memoize): Adapt to FULL_ARITY changes. Remove LETREC case.
(unmemoize): Adapt to memoized code change.
* libguile/eval.c (BOOT_CLOSURE_PARSE_FULL): Adapt to parse ninits and
unbound instead of inits.
(eval): Lexical-ref can no longer raise an error.
(prepare_boot_closure_env_for_apply): Adapt to inits change.
* module/ice-9/eval.scm (primitive-eval): Adapt to ninits/unbound
change.
* libguile/expand.c (expand_named_let): Fix lambda-case creation to make
lists for opt and inits.
Diffstat (limited to 'libguile/memoize.c')
-rw-r--r-- | libguile/memoize.c | 94 |
1 files changed, 16 insertions, 78 deletions
diff --git a/libguile/memoize.c b/libguile/memoize.c index 36766e83e..9651cadc6 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -119,9 +119,9 @@ scm_t_bits scm_tc16_memoized; scm_list_1 (SCM_I_MAKINUM (nreq)) #define REST_ARITY(nreq, rest) \ scm_list_2 (SCM_I_MAKINUM (nreq), rest) -#define FULL_ARITY(nreq, rest, nopt, kw, inits, alt) \ - scm_list_n (SCM_I_MAKINUM (nreq), rest, SCM_I_MAKINUM (nopt), kw, inits, \ - alt, SCM_UNDEFINED) +#define FULL_ARITY(nreq, rest, nopt, kw, ninits, unbound, alt) \ + scm_list_n (SCM_I_MAKINUM (nreq), rest, SCM_I_MAKINUM (nopt), kw, \ + SCM_I_MAKINUM (ninits), unbound, alt, SCM_UNDEFINED) #define MAKMEMO_LAMBDA(body, arity, meta) \ MAKMEMO (SCM_M_LAMBDA, \ scm_cons (body, scm_cons (meta, arity))) @@ -418,8 +418,8 @@ memoize (SCM exp, SCM env) case SCM_EXPANDED_LAMBDA_CASE: { SCM req, rest, opt, kw, inits, vars, body, alt; - SCM walk, minits, arity, rib, new_env; - int nreq, nopt; + SCM unbound, arity, rib; + int nreq, nopt, ninits; req = REF (exp, LAMBDA_CASE, REQ); rest = scm_not (scm_not (REF (exp, LAMBDA_CASE, REST))); @@ -432,17 +432,12 @@ memoize (SCM exp, SCM env) nreq = scm_ilength (req); nopt = scm_is_pair (opt) ? scm_ilength (opt) : 0; - - /* The vars are the gensyms, according to the divine plan. But we need - to memoize the inits within their appropriate environment, - complicating things. */ + ninits = scm_ilength (inits); + /* This relies on assignment conversion turning inits into a + sequence of CONST expressions whose values are a unique + "unbound" token. */ + unbound = ninits ? REF (CAR (inits), CONST, EXP) : SCM_BOOL_F; rib = scm_vector (vars); - new_env = scm_cons (rib, env); - - minits = SCM_EOL; - for (walk = inits; scm_is_pair (walk); walk = CDR (walk)) - minits = scm_cons (memoize (CAR (walk), new_env), minits); - minits = scm_reverse_x (minits, SCM_UNDEFINED); if (scm_is_true (kw)) { @@ -468,12 +463,13 @@ memoize (SCM exp, SCM env) arity = REST_ARITY (nreq, SCM_BOOL_T); } else if (scm_is_true (alt)) - arity = FULL_ARITY (nreq, rest, nopt, kw, minits, + arity = FULL_ARITY (nreq, rest, nopt, kw, ninits, unbound, SCM_MEMOIZED_ARGS (memoize (alt, env))); else - arity = FULL_ARITY (nreq, rest, nopt, kw, minits, SCM_BOOL_F); + arity = FULL_ARITY (nreq, rest, nopt, kw, ninits, unbound, + SCM_BOOL_F); - return MAKMEMO_LAMBDA (memoize (body, new_env), arity, + return MAKMEMO_LAMBDA (memoize (body, scm_cons (rib, env)), arity, SCM_BOOL_F /* meta, filled in later */); } @@ -497,64 +493,6 @@ memoize (SCM exp, SCM env) (MAKMEMO_LET (inits, memoize (body, new_env)), env); } - case SCM_EXPANDED_LETREC: - { - SCM vars, varsv, exps, expsv, 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)); - - varsv = scm_vector (vars); - nvars = VECTOR_LENGTH (varsv); - expsv = scm_vector (exps); - - undefs = scm_c_make_vector (nvars, MAKMEMO_QUOTE (SCM_UNDEFINED)); - new_env = scm_cons (varsv, capture_env (env)); - - if (in_order_p) - { - SCM body_exps = memoize (body, new_env); - for (i = nvars - 1; i >= 0; i--) - { - SCM init = memoize (VECTOR_REF (expsv, i), new_env); - body_exps = MAKMEMO_SEQ (MAKMEMO_LEX_SET (make_pos (0, i), init), - body_exps); - } - return maybe_makmemo_capture_module - (MAKMEMO_LET (undefs, body_exps), env); - } - else - { - SCM sets = SCM_BOOL_F, inits = scm_c_make_vector (nvars, SCM_BOOL_F); - for (i = nvars - 1; i >= 0; i--) - { - SCM init, set; - - init = memoize (VECTOR_REF (expsv, i), new_env); - VECTOR_SET (inits, i, init); - - set = MAKMEMO_LEX_SET (make_pos (1, i), - MAKMEMO_LEX_REF (make_pos (0, i))); - if (scm_is_false (sets)) - sets = set; - else - sets = MAKMEMO_SEQ (set, sets); - } - - if (scm_is_false (sets)) - return memoize (body, env); - - return maybe_makmemo_capture_module - (MAKMEMO_LET (undefs, - MAKMEMO_SEQ (MAKMEMO_LET (inits, sets), - memoize (body, new_env))), - env); - } - } - default: abort (); } @@ -670,7 +608,7 @@ unmemoize (const SCM expr) { SCM alt, tail; - alt = CADDR (CDDDR (spec)); + alt = CADDDR (CDDDR (spec)); if (scm_is_true (alt)) tail = CDR (unmemoize (alt)); else @@ -682,7 +620,7 @@ unmemoize (const SCM expr) CADR (spec), CADDR (spec), CADDDR (spec), - unmemoize_exprs (CADR (CDDDR (spec)))), + CADR (CDDDR (spec))), unmemoize (body)), tail)); } |