summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-10-27 09:52:39 +0100
committerAndy Wingo <wingo@pobox.com>2013-10-27 09:52:39 +0100
commit0720f70ed7e9de2685409abfe4e2c0dd01f81b74 (patch)
tree695650decf699cbb5b544fd9dec881adcfe56e47
parentc450b47723438ad9e517b02a45b577b7f7fd848b (diff)
Memoized expressions are pairs, not SMOBs
* libguile/memoize.c (MAKMEMO): Memoized objects are pairs now, not SMOBs. This lets eval.scm destructure them more efficiently. (scm_print_memoized, scm_memoized_p, scm_memoized_expression_typecode) (scm_memoized_expression_data): Remove these interfaces. (unmemoize, scm_memoize_variable_access_x): Remove SMOB type checks. (scm_init_memoize): Remove SMOB type definition. * libguile/memoize.h (scm_tc16_memoized, SCM_MEMOIZED_P) (scm_memoized_expression_typecode, scm_memoized_expression_data) (scm_memoized_p): Remove declarations. * libguile/validate.h (SCM_VALIDATE_MEMOIZED): Remove declaration. * libguile/eval.c (eval): Remove memoized type check, and inline the inum unpacking. * module/ice-9/eval.scm (memoized-expression-case): Use car and cdr to destructure memoized expressions. A big win!
-rw-r--r--libguile/eval.c4
-rw-r--r--libguile/memoize.c58
-rw-r--r--libguile/memoize.h10
-rw-r--r--libguile/validate.h4
-rw-r--r--module/ice-9/eval.scm4
5 files changed, 11 insertions, 69 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index 36199a60b..43a182a5a 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -266,11 +266,9 @@ eval (SCM x, SCM env)
loop:
SCM_TICK;
- if (!SCM_MEMOIZED_P (x))
- abort ();
mx = SCM_MEMOIZED_ARGS (x);
- switch (SCM_MEMOIZED_TAG (x))
+ switch (SCM_I_INUM (SCM_CAR (x)))
{
case SCM_M_SEQ:
eval (CAR (mx), env);
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 10e193c63..6eb36d437 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -109,7 +109,7 @@ do_pop_fluid (void)
scm_t_bits scm_tc16_memoized;
#define MAKMEMO(n, args) \
- (scm_cell (scm_tc16_memoized | ((n) << 16), SCM_UNPACK (args)))
+ (scm_cons (SCM_I_MAKINUM (n), args))
#define MAKMEMO_SEQ(head,tail) \
MAKMEMO (SCM_M_SEQ, scm_cons (head, tail))
@@ -179,15 +179,6 @@ static const char *const memoized_tags[] =
"call-with-prompt",
};
-static int
-scm_print_memoized (SCM memoized, SCM port, scm_print_state *pstate)
-{
- scm_puts_unlocked ("#<memoized ", port);
- scm_write (scm_unmemoize_expression (memoized), port);
- scm_puts_unlocked (">", port);
- return 1;
-}
-
@@ -601,9 +592,6 @@ unmemoize (const SCM expr)
{
SCM args;
- if (!SCM_MEMOIZED_P (expr))
- abort ();
-
args = SCM_MEMOIZED_ARGS (expr);
switch (SCM_MEMOIZED_TAG (expr))
{
@@ -706,47 +694,15 @@ unmemoize (const SCM expr)
-SCM_DEFINE (scm_memoized_p, "memoized?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} if @var{obj} is memoized.")
-#define FUNC_NAME s_scm_memoized_p
-{
- return scm_from_bool (SCM_MEMOIZED_P (obj));
-}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_unmemoize_expression, "unmemoize-expression", 1, 0, 0,
(SCM m),
"Unmemoize the memoized expression @var{m}.")
#define FUNC_NAME s_scm_unmemoize_expression
{
- SCM_VALIDATE_MEMOIZED (1, m);
return unmemoize (m);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_memoized_expression_typecode, "memoized-expression-typecode", 1, 0, 0,
- (SCM m),
- "Return the typecode from the memoized expression @var{m}.")
-#define FUNC_NAME s_scm_memoized_expression_typecode
-{
- SCM_VALIDATE_MEMOIZED (1, m);
-
- /* The tag is a 16-bit integer so it fits in an inum. */
- return SCM_I_MAKINUM (SCM_MEMOIZED_TAG (m));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_memoized_expression_data, "memoized-expression-data", 1, 0, 0,
- (SCM m),
- "Return the data from the memoized expression @var{m}.")
-#define FUNC_NAME s_scm_memoized_expression_data
-{
- SCM_VALIDATE_MEMOIZED (1, m);
- return SCM_MEMOIZED_ARGS (m);
-}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_memoized_typecode, "memoized-typecode", 1, 0, 0,
(SCM sym),
"Return the memoized typecode corresponding to the symbol @var{sym}.")
@@ -777,9 +733,8 @@ SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0,
"Look up and cache the variable that @var{m} will access, returning the variable.")
#define FUNC_NAME s_scm_memoize_variable_access_x
{
- SCM mx;
- SCM_VALIDATE_MEMOIZED (1, m);
- mx = SCM_MEMOIZED_ARGS (m);
+ SCM mx = SCM_MEMOIZED_ARGS (m);
+
switch (SCM_MEMOIZED_TAG (m))
{
case SCM_M_TOPLEVEL_REF:
@@ -790,7 +745,7 @@ SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0,
SCM var = scm_module_variable (mod, mx);
if (scm_is_false (var) || scm_is_false (scm_variable_bound_p (var)))
error_unbound_variable (mx);
- SCM_SET_SMOB_OBJECT (m, var);
+ SCM_SETCDR (m, var);
return var;
}
@@ -821,7 +776,7 @@ SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0,
var = scm_module_lookup (mod, CADR (mx));
if (scm_is_false (scm_variable_bound_p (var)))
error_unbound_variable (CADR (mx));
- SCM_SET_SMOB_OBJECT (m, var);
+ SCM_SETCDR (m, var);
return var;
}
@@ -853,9 +808,6 @@ SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0,
void
scm_init_memoize ()
{
- scm_tc16_memoized = scm_make_smob_type ("%memoized", 0);
- scm_set_smob_print (scm_tc16_memoized, scm_print_memoized);
-
#include "libguile/memoize.x"
wind = scm_c_make_gsubr ("wind", 2, 0, 0, do_wind);
diff --git a/libguile/memoize.h b/libguile/memoize.h
index 7f7624fd3..95e92a3a9 100644
--- a/libguile/memoize.h
+++ b/libguile/memoize.h
@@ -58,11 +58,8 @@ SCM_API SCM scm_sym_args;
/* {Memoized Source}
*/
-SCM_INTERNAL scm_t_bits scm_tc16_memoized;
-
-#define SCM_MEMOIZED_P(x) (SCM_SMOB_PREDICATE (scm_tc16_memoized, (x)))
-#define SCM_MEMOIZED_TAG(x) (SCM_SMOB_FLAGS (x))
-#define SCM_MEMOIZED_ARGS(x) (SCM_SMOB_OBJECT (x))
+#define SCM_MEMOIZED_TAG(x) (scm_to_uint16 (scm_car (x)))
+#define SCM_MEMOIZED_ARGS(x) (scm_cdr (x))
enum
{
@@ -90,11 +87,8 @@ enum
SCM_INTERNAL SCM scm_memoize_expression (SCM exp);
SCM_INTERNAL SCM scm_unmemoize_expression (SCM memoized);
-SCM_INTERNAL SCM scm_memoized_expression_typecode (SCM memoized);
-SCM_INTERNAL SCM scm_memoized_expression_data (SCM memoized);
SCM_INTERNAL SCM scm_memoized_typecode (SCM sym);
SCM_INTERNAL SCM scm_memoize_variable_access_x (SCM memoized, SCM module);
-SCM_API SCM scm_memoized_p (SCM obj);
SCM_INTERNAL void scm_init_memoize (void);
diff --git a/libguile/validate.h b/libguile/validate.h
index b4d544151..68ff3744d 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -4,7 +4,7 @@
#define SCM_VALIDATE_H
/* Copyright (C) 1999, 2000, 2001, 2002, 2004, 2006, 2007, 2009,
- * 2011, 2012 Free Software Foundation, Inc.
+ * 2011, 2012, 2013 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -293,8 +293,6 @@
#define SCM_VALIDATE_VARIABLE(pos, var) SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable")
-#define SCM_VALIDATE_MEMOIZED(pos, obj) SCM_MAKE_VALIDATE_MSG (pos, obj, MEMOIZED_P, "memoized code")
-
#define SCM_VALIDATE_PROC(pos, proc) \
do { \
SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index e76283150..ed5103955 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -264,8 +264,8 @@
(lambda (x)
(syntax-case x ()
((_ mx c ...)
- #'(let ((tag (memoized-expression-typecode mx))
- (data (memoized-expression-data mx)))
+ #'(let ((tag (car mx))
+ (data (cdr mx)))
(mx-match mx data tag c ...)))))))