mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
add memoized expression accessors to scheme
* libguile/eval.c: Fix a comment. (eval): Abstract out the variable memoization into a function, scm_memoize_variable_access_x. * libguile/memoize.c (memoized_tags): Fix a couple names. (scm_memoize_variable_access_x): New internal function. Actually it's public to Scheme, but we can't do much about that, because the new evaluator will need it. (scm_memoized_expression_typecode, scm_memoized_expression_data): New accessors for memoized code, for Scheme. (scm_memoized_typecode): Looks up the typecode for a symbol.
This commit is contained in:
Andy Wingo
parent
c7a2a803bd
commit
3149a5b60d
3 changed files with 137 additions and 38 deletions
|
|
@ -120,13 +120,6 @@
|
|||
|
||||
SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable");
|
||||
|
||||
static void error_unbound_variable (SCM symbol) SCM_NORETURN;
|
||||
static void error_unbound_variable (SCM symbol)
|
||||
{
|
||||
scm_error (scm_unbound_variable_key, NULL, "Unbound variable: ~S",
|
||||
scm_list_1 (symbol), SCM_BOOL_F);
|
||||
}
|
||||
|
||||
static void error_used_before_defined (void)
|
||||
{
|
||||
scm_error (scm_unbound_variable_key, NULL,
|
||||
|
|
@ -151,7 +144,7 @@ scm_badargsp (SCM formals, SCM args)
|
|||
static SCM apply (SCM proc, SCM args);
|
||||
|
||||
/* the environment:
|
||||
((SYM . VAL) (SYM . VAL) ... . MOD)
|
||||
(VAL ... . MOD)
|
||||
If MOD is #f, it means the environment was captured before modules were
|
||||
booted.
|
||||
If MOD is the literal value '(), we are evaluating at the top level, and so
|
||||
|
|
@ -347,14 +340,10 @@ eval (SCM x, SCM env)
|
|||
return SCM_VARIABLE_REF (mx);
|
||||
else
|
||||
{
|
||||
SCM var;
|
||||
while (scm_is_pair (env))
|
||||
env = scm_cdr (env);
|
||||
var = scm_module_variable (CAPTURE_ENV (env), mx);
|
||||
if (scm_is_false (var) || scm_is_false (scm_variable_bound_p (var)))
|
||||
error_unbound_variable (mx);
|
||||
SCM_SET_SMOB_OBJECT (x, var);
|
||||
return SCM_VARIABLE_REF (var);
|
||||
return SCM_VARIABLE_REF
|
||||
(scm_memoize_variable_access_x (x, CAPTURE_ENV (env)));
|
||||
}
|
||||
|
||||
case SCM_M_TOPLEVEL_SET:
|
||||
|
|
@ -370,11 +359,9 @@ eval (SCM x, SCM env)
|
|||
{
|
||||
while (scm_is_pair (env))
|
||||
env = scm_cdr (env);
|
||||
var = scm_module_variable (CAPTURE_ENV (env), var);
|
||||
if (scm_is_false (var) || scm_is_false (scm_variable_bound_p (var)))
|
||||
error_unbound_variable (CAR (mx));
|
||||
SCM_SETCAR (mx, var);
|
||||
SCM_VARIABLE_SET (var, val);
|
||||
SCM_VARIABLE_SET
|
||||
(scm_memoize_variable_access_x (x, CAPTURE_ENV (env)),
|
||||
val);
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
}
|
||||
|
|
@ -383,16 +370,8 @@ eval (SCM x, SCM env)
|
|||
if (SCM_VARIABLEP (mx))
|
||||
return SCM_VARIABLE_REF (mx);
|
||||
else
|
||||
{
|
||||
SCM mod, var;
|
||||
mod = scm_resolve_module (CAR (mx));
|
||||
if (scm_is_true (CDDR (mx)))
|
||||
mod = scm_module_public_interface (mod);
|
||||
var = scm_module_lookup (mod, CADR (mx));
|
||||
if (scm_is_true (scm_variable_bound_p (var)))
|
||||
SCM_SET_SMOB_OBJECT (x, var);
|
||||
return scm_variable_ref (var);
|
||||
}
|
||||
return SCM_VARIABLE_REF
|
||||
(scm_memoize_variable_access_x (x, SCM_BOOL_F));
|
||||
|
||||
case SCM_M_MODULE_SET:
|
||||
if (SCM_VARIABLEP (CDR (mx)))
|
||||
|
|
@ -402,13 +381,9 @@ eval (SCM x, SCM env)
|
|||
}
|
||||
else
|
||||
{
|
||||
SCM mod, var;
|
||||
mod = scm_resolve_module (CADR (mx));
|
||||
if (scm_is_true (CDDDR (mx)))
|
||||
mod = scm_module_public_interface (mod);
|
||||
var = scm_module_lookup (mod, CADDR (mx));
|
||||
SCM_SET_SMOB_OBJECT (x, var);
|
||||
SCM_VARIABLE_SET (var, eval (CAR (mx), env));
|
||||
SCM_VARIABLE_SET
|
||||
(scm_memoize_variable_access_x (x, SCM_BOOL_F),
|
||||
eval (CAR (mx), env));
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -236,7 +236,7 @@ static const char *const memoized_tags[] =
|
|||
"quote",
|
||||
"define",
|
||||
"apply",
|
||||
"call-with-current-continuation",
|
||||
"call/cc",
|
||||
"call-with-values",
|
||||
"call",
|
||||
"lexical-ref",
|
||||
|
|
@ -244,7 +244,7 @@ static const char *const memoized_tags[] =
|
|||
"toplevel-ref",
|
||||
"toplevel-set!",
|
||||
"module-ref",
|
||||
"module-set",
|
||||
"module-set!",
|
||||
};
|
||||
|
||||
static int
|
||||
|
|
@ -1121,6 +1121,126 @@ SCM_DEFINE (scm_unmemoize_expression, "unmemoize-expression", 1, 0, 0,
|
|||
}
|
||||
#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);
|
||||
return scm_from_uint16 (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}.")
|
||||
#define FUNC_NAME s_scm_memoized_typecode
|
||||
{
|
||||
int i;
|
||||
|
||||
SCM_VALIDATE_SYMBOL (1, sym);
|
||||
|
||||
for (i = 0; i < sizeof(memoized_tags)/sizeof(const char*); i++)
|
||||
if (strcmp (scm_i_symbol_chars (sym), memoized_tags[i]) == 0)
|
||||
return scm_from_int32 (i);
|
||||
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable");
|
||||
static void error_unbound_variable (SCM symbol) SCM_NORETURN;
|
||||
static void error_unbound_variable (SCM symbol)
|
||||
{
|
||||
scm_error (scm_unbound_variable_key, NULL, "Unbound variable: ~S",
|
||||
scm_list_1 (symbol), SCM_BOOL_F);
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_memoize_variable_access_x, "memoize-variable-access!", 2, 0, 0,
|
||||
(SCM m, SCM mod),
|
||||
"Look up and cache the variable that @var{m} will access, returning the variable.")
|
||||
#define FUNC_NAME s_scm_memoized_expression_data
|
||||
{
|
||||
SCM mx;
|
||||
SCM_VALIDATE_MEMOIZED (1, m);
|
||||
mx = SCM_MEMOIZED_ARGS (m);
|
||||
switch (SCM_MEMOIZED_TAG (m))
|
||||
{
|
||||
case SCM_M_TOPLEVEL_REF:
|
||||
if (SCM_VARIABLEP (mx))
|
||||
return mx;
|
||||
else
|
||||
{
|
||||
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);
|
||||
return var;
|
||||
}
|
||||
|
||||
case SCM_M_TOPLEVEL_SET:
|
||||
{
|
||||
SCM var = CAR (mx);
|
||||
if (SCM_VARIABLEP (var))
|
||||
return var;
|
||||
else
|
||||
{
|
||||
var = scm_module_variable (mod, var);
|
||||
if (scm_is_false (var))
|
||||
error_unbound_variable (CAR (mx));
|
||||
SCM_SETCAR (mx, var);
|
||||
return var;
|
||||
}
|
||||
}
|
||||
|
||||
case SCM_M_MODULE_REF:
|
||||
if (SCM_VARIABLEP (mx))
|
||||
return mx;
|
||||
else
|
||||
{
|
||||
SCM var;
|
||||
mod = scm_resolve_module (CAR (mx));
|
||||
if (scm_is_true (CDDR (mx)))
|
||||
mod = scm_module_public_interface (mod);
|
||||
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);
|
||||
return var;
|
||||
}
|
||||
|
||||
case SCM_M_MODULE_SET:
|
||||
/* FIXME: not quite threadsafe */
|
||||
if (SCM_VARIABLEP (CDR (mx)))
|
||||
return CDR (mx);
|
||||
else
|
||||
{
|
||||
SCM var;
|
||||
mod = scm_resolve_module (CADR (mx));
|
||||
if (scm_is_true (CDDDR (mx)))
|
||||
mod = scm_module_public_interface (mod);
|
||||
var = scm_module_lookup (mod, CADDR (mx));
|
||||
SCM_SETCDR (mx, var);
|
||||
return var;
|
||||
}
|
||||
|
||||
default:
|
||||
scm_wrong_type_arg (FUNC_NAME, 1, m);
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -92,6 +92,10 @@ 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);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue