diff options
author | Andy Wingo <wingo@pobox.com> | 2013-10-27 09:52:39 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-10-27 09:52:39 +0100 |
commit | 0720f70ed7e9de2685409abfe4e2c0dd01f81b74 (patch) | |
tree | 695650decf699cbb5b544fd9dec881adcfe56e47 | |
parent | c450b47723438ad9e517b02a45b577b7f7fd848b (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.c | 4 | ||||
-rw-r--r-- | libguile/memoize.c | 58 | ||||
-rw-r--r-- | libguile/memoize.h | 10 | ||||
-rw-r--r-- | libguile/validate.h | 4 | ||||
-rw-r--r-- | module/ice-9/eval.scm | 4 |
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 ...))))))) |