summaryrefslogtreecommitdiff
path: root/libguile/memoize.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/memoize.c')
-rw-r--r--libguile/memoize.c71
1 files changed, 49 insertions, 22 deletions
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 911d97294..1be276b36 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -67,8 +67,8 @@ scm_t_bits scm_tc16_memoized;
#define MAKMEMO(n, args) \
(scm_cell (scm_tc16_memoized | ((n) << 16), SCM_UNPACK (args)))
-#define MAKMEMO_BEGIN(exps) \
- MAKMEMO (SCM_M_BEGIN, exps)
+#define MAKMEMO_SEQ(head,tail) \
+ MAKMEMO (SCM_M_SEQ, scm_cons (head, tail))
#define MAKMEMO_IF(test, then, else_) \
MAKMEMO (SCM_M_IF, scm_cons (test, scm_cons (then, else_)))
#define FIXED_ARITY(nreq) \
@@ -124,7 +124,7 @@ scm_t_bits scm_tc16_memoizer;
/* This table must agree with the list of M_ constants in memoize.h */
static const char *const memoized_tags[] =
{
- "begin",
+ "seq",
"if",
"lambda",
"let",
@@ -148,9 +148,9 @@ static const char *const memoized_tags[] =
static int
scm_print_memoized (SCM memoized, SCM port, scm_print_state *pstate)
{
- scm_puts ("#<memoized ", port);
+ scm_puts_unlocked ("#<memoized ", port);
scm_write (scm_unmemoize_expression (memoized), port);
- scm_puts (">", port);
+ scm_puts_unlocked (">", port);
return 1;
}
@@ -241,12 +241,12 @@ memoize (SCM exp, SCM env)
memoize (REF (exp, CONDITIONAL, CONSEQUENT), env),
memoize (REF (exp, CONDITIONAL, ALTERNATE), env));
- case SCM_EXPANDED_APPLICATION:
+ case SCM_EXPANDED_CALL:
{
SCM proc, args;
- proc = REF (exp, APPLICATION, PROC);
- args = memoize_exps (REF (exp, APPLICATION, ARGS), env);
+ proc = REF (exp, CALL, PROC);
+ args = memoize_exps (REF (exp, CALL, ARGS), env);
if (SCM_EXPANDED_TYPE (proc) == SCM_EXPANDED_TOPLEVEL_REF)
{
@@ -263,8 +263,23 @@ memoize (SCM exp, SCM env)
return MAKMEMO_CALL (memoize (proc, env), scm_ilength (args), args);
}
- case SCM_EXPANDED_SEQUENCE:
- return MAKMEMO_BEGIN (memoize_exps (REF (exp, SEQUENCE, EXPS), env));
+ case SCM_EXPANDED_PRIMCALL:
+ {
+ SCM proc, args;
+
+ if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
+ proc = MAKMEMO_TOP_REF (REF (exp, PRIMCALL, NAME));
+ else
+ proc = MAKMEMO_MOD_REF (list_of_guile, REF (exp, PRIMCALL, NAME),
+ SCM_BOOL_F);
+ args = memoize_exps (REF (exp, PRIMCALL, ARGS), env);
+
+ return MAKMEMO_CALL (proc, scm_ilength (args), args);
+ }
+
+ case SCM_EXPANDED_SEQ:
+ return MAKMEMO_SEQ (memoize (REF (exp, SEQ, HEAD), env),
+ memoize (REF (exp, SEQ, TAIL), env));
case SCM_EXPANDED_LAMBDA:
/* The body will be a lambda-case. */
@@ -394,18 +409,21 @@ memoize (SCM exp, SCM env)
if (in_order_p)
{
- SCM body_exps = SCM_EOL;
+ SCM body_exps = SCM_EOL, seq;
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));
+
+ seq = memoize (body, new_env);
+ for (; scm_is_pair (body_exps); body_exps = CDR (body_exps))
+ seq = MAKMEMO_SEQ (CAR (body_exps), seq);
+
+ return MAKMEMO_LET (undefs, seq);
}
else
{
- SCM sets = SCM_EOL, inits = SCM_EOL;
+ SCM sets = SCM_EOL, inits = SCM_EOL, set_seq;
for (; scm_is_pair (exps); exps = CDR (exps), i--)
{
sets = scm_cons (MAKMEMO_LEX_SET ((i-1) + nvars,
@@ -414,10 +432,18 @@ memoize (SCM exp, SCM env)
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))));
+
+ sets = scm_reverse_x (sets, SCM_UNDEFINED);
+ if (scm_is_null (sets))
+ return memoize (body, env);
+
+ for (set_seq = CAR (sets), sets = CDR (sets); scm_is_pair (sets);
+ sets = CDR (sets))
+ set_seq = MAKMEMO_SEQ (CAR (sets), set_seq);
+
+ return MAKMEMO_LET (undefs,
+ MAKMEMO_SEQ (MAKMEMO_LET (inits, set_seq),
+ memoize (body, new_env)));
}
}
@@ -592,7 +618,7 @@ unmemoize_lexical (SCM n)
char buf[16];
buf[15] = 0;
snprintf (buf, 15, "<%u>", scm_to_uint32 (n));
- return scm_from_locale_symbol (buf);
+ return scm_from_utf8_symbol (buf);
}
static SCM
@@ -608,8 +634,9 @@ unmemoize (const SCM expr)
{
case SCM_M_APPLY:
return scm_cons (scm_sym_atapply, unmemoize_exprs (args));
- case SCM_M_BEGIN:
- return scm_cons (scm_sym_begin, unmemoize_exprs (args));
+ case SCM_M_SEQ:
+ return scm_list_3 (scm_sym_begin, unmemoize (CAR (args)),
+ unmemoize (CDR (args)));
case SCM_M_CALL:
return scm_cons (unmemoize (CAR (args)), unmemoize_exprs (CDDR (args)));
case SCM_M_CONT: