mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 12:20:26 +02:00
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!
This commit is contained in:
Andy Wingo
parent
c450b47723
commit
0720f70ed7
5 changed files with 11 additions and 69 deletions
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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); \
|
||||
|
|
|
|||
|
|
@ -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 ...)))))))
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue