summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-12-07 15:52:34 +0100
committerAndy Wingo <wingo@pobox.com>2014-12-07 15:52:34 +0100
commite6a42e676528bf56c6535a7e0c79e936a6d2a818 (patch)
tree82802288051ec1941785bd49bbbbac18e57db6c1
parenta3cae847d0e6c77494c7cf5f395e8234e3b9b5cf (diff)
downloadguile-e6a42e676528bf56c6535a7e0c79e936a6d2a818.tar.gz
Simplify variable resolution in the evaluator
* libguile/expand.c (convert_assignment): Handle creation of the default lambda-case body here. * libguile/eval.c (eval): * module/ice-9/eval.scm (primitive-eval): * libguile/memoize.h: * libguile/memoize.c (MAKMEMO_BOX_REF, MAKMEMO_BOX_SET): (MAKMEMO_TOP_BOX, MAKMEMO_MOD_BOX): Refactor all global var resolution to go through "resolve". Add "box-ref" and "box-set!". Rename memoize-variable-access! to %resolve-variable, and don't be destructive.
-rw-r--r--libguile/eval.c60
-rw-r--r--libguile/expand.c16
-rw-r--r--libguile/memoize.c236
-rw-r--r--libguile/memoize.h10
-rw-r--r--module/ice-9/eval.scm44
5 files changed, 155 insertions, 211 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index 9f0955748..b69b5b2b4 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -305,10 +305,6 @@ eval (SCM x, SCM env)
case SCM_M_QUOTE:
return mx;
- case SCM_M_DEFINE:
- scm_define (CAR (mx), EVAL1 (CDR (mx), env));
- return SCM_UNSPECIFIED;
-
case SCM_M_CAPTURE_MODULE:
return eval (mx, scm_current_module ());
@@ -398,51 +394,31 @@ eval (SCM x, SCM env)
return SCM_UNSPECIFIED;
}
- case SCM_M_TOPLEVEL_REF:
- if (SCM_VARIABLEP (mx))
- return SCM_VARIABLE_REF (mx);
- else
- {
- env = env_tail (env);
- return SCM_VARIABLE_REF (scm_memoize_variable_access_x (x, env));
- }
+ case SCM_M_BOX_REF:
+ {
+ SCM box = mx;
- case SCM_M_TOPLEVEL_SET:
+ return scm_variable_ref (EVAL1 (box, env));
+ }
+
+ case SCM_M_BOX_SET:
{
- SCM var = CAR (mx);
- SCM val = EVAL1 (CDR (mx), env);
- if (SCM_VARIABLEP (var))
- {
- SCM_VARIABLE_SET (var, val);
- return SCM_UNSPECIFIED;
- }
- else
- {
- env = env_tail (env);
- SCM_VARIABLE_SET (scm_memoize_variable_access_x (x, env), val);
- return SCM_UNSPECIFIED;
- }
+ SCM box = CAR (mx), val = CDR (mx);
+
+ return scm_variable_set_x (EVAL1 (box, env), EVAL1 (val, env));
}
- case SCM_M_MODULE_REF:
+ case SCM_M_RESOLVE:
if (SCM_VARIABLEP (mx))
- return SCM_VARIABLE_REF (mx);
- else
- return SCM_VARIABLE_REF
- (scm_memoize_variable_access_x (x, SCM_BOOL_F));
-
- case SCM_M_MODULE_SET:
- if (SCM_VARIABLEP (CDR (mx)))
- {
- SCM_VARIABLE_SET (CDR (mx), EVAL1 (CAR (mx), env));
- return SCM_UNSPECIFIED;
- }
+ return mx;
else
{
- SCM_VARIABLE_SET
- (scm_memoize_variable_access_x (x, SCM_BOOL_F),
- EVAL1 (CAR (mx), env));
- return SCM_UNSPECIFIED;
+ SCM mod, var;
+
+ var = scm_sys_resolve_variable (mx, env_tail (env));
+ scm_set_cdr_x (x, var);
+
+ return var;
}
case SCM_M_CALL_WITH_PROMPT:
diff --git a/libguile/expand.c b/libguile/expand.c
index e1c6c18a5..91097c2d5 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -1412,7 +1412,21 @@ convert_assignment (SCM exp, SCM assigned)
return LAMBDA
(REF (exp, LAMBDA, SRC),
REF (exp, LAMBDA, META),
- convert_assignment (REF (exp, LAMBDA, BODY), assigned));
+ scm_is_false (REF (exp, LAMBDA, BODY))
+ /* Give a body to case-lambda with no clauses. */
+ ? LAMBDA_CASE (SCM_BOOL_F, SCM_EOL, SCM_EOL, SCM_BOOL_F, SCM_BOOL_F,
+ SCM_EOL, SCM_EOL,
+ PRIMCALL
+ (SCM_BOOL_F,
+ scm_from_latin1_symbol ("throw"),
+ scm_list_5 (CONST_ (SCM_BOOL_F, scm_args_number_key),
+ CONST_ (SCM_BOOL_F, SCM_BOOL_F),
+ CONST_ (SCM_BOOL_F, scm_from_latin1_string
+ ("Wrong number of arguments")),
+ CONST_ (SCM_BOOL_F, SCM_EOL),
+ CONST_ (SCM_BOOL_F, SCM_BOOL_F))),
+ SCM_BOOL_F)
+ : convert_assignment (REF (exp, LAMBDA, BODY), assigned));
case SCM_EXPANDED_LAMBDA_CASE:
{
diff --git a/libguile/memoize.c b/libguile/memoize.c
index 8ebc1a02c..cefb26938 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -131,8 +131,6 @@ scm_t_bits scm_tc16_memoized;
MAKMEMO (SCM_M_LET, scm_cons (inits, body))
#define MAKMEMO_QUOTE(exp) \
MAKMEMO (SCM_M_QUOTE, exp)
-#define MAKMEMO_DEFINE(var, val) \
- MAKMEMO (SCM_M_DEFINE, scm_cons (var, val))
#define MAKMEMO_CAPTURE_MODULE(exp) \
MAKMEMO (SCM_M_CAPTURE_MODULE, exp)
#define MAKMEMO_APPLY(proc, args)\
@@ -147,14 +145,16 @@ scm_t_bits scm_tc16_memoized;
MAKMEMO (SCM_M_LEXICAL_REF, pos)
#define MAKMEMO_LEX_SET(pos, val) \
MAKMEMO (SCM_M_LEXICAL_SET, scm_cons (pos, val))
-#define MAKMEMO_TOP_REF(var) \
- MAKMEMO (SCM_M_TOPLEVEL_REF, var)
-#define MAKMEMO_TOP_SET(var, val) \
- MAKMEMO (SCM_M_TOPLEVEL_SET, scm_cons (var, val))
-#define MAKMEMO_MOD_REF(mod, var, public) \
- MAKMEMO (SCM_M_MODULE_REF, scm_cons (mod, scm_cons (var, public)))
-#define MAKMEMO_MOD_SET(val, mod, var, public) \
- MAKMEMO (SCM_M_MODULE_SET, scm_cons (val, scm_cons (mod, scm_cons (var, public))))
+#define MAKMEMO_BOX_REF(box) \
+ MAKMEMO (SCM_M_BOX_REF, box)
+#define MAKMEMO_BOX_SET(box, val) \
+ MAKMEMO (SCM_M_BOX_SET, scm_cons (box, val))
+#define MAKMEMO_TOP_BOX(mode, var) \
+ MAKMEMO (SCM_M_RESOLVE, scm_cons (SCM_I_MAKINUM (mode), var))
+#define MAKMEMO_MOD_BOX(mode, mod, var, public) \
+ MAKMEMO (SCM_M_RESOLVE, \
+ scm_cons (SCM_I_MAKINUM (mode), \
+ scm_cons (mod, scm_cons (var, public))))
#define MAKMEMO_CALL_WITH_PROMPT(tag, thunk, handler) \
MAKMEMO (SCM_M_CALL_WITH_PROMPT, scm_cons (tag, scm_cons (thunk, handler)))
@@ -170,7 +170,6 @@ static const char *const memoized_tags[] =
"capture-env",
"let",
"quote",
- "define",
"capture-module",
"apply",
"call/cc",
@@ -178,10 +177,9 @@ static const char *const memoized_tags[] =
"call",
"lexical-ref",
"lexical-set!",
- "toplevel-ref",
- "toplevel-set!",
- "module-ref",
- "module-set!",
+ "box-ref",
+ "box-set!",
+ "resolve",
"call-with-prompt",
};
@@ -370,11 +368,14 @@ memoize (SCM exp, SCM env)
case SCM_EXPANDED_PRIMITIVE_REF:
if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
return maybe_makmemo_capture_module
- (MAKMEMO_TOP_REF (REF (exp, PRIMITIVE_REF, NAME)),
+ (MAKMEMO_BOX_REF (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_REF,
+ REF (exp, PRIMITIVE_REF, NAME))),
env);
else
- return MAKMEMO_MOD_REF (list_of_guile, REF (exp, PRIMITIVE_REF, NAME),
- SCM_BOOL_F);
+ return MAKMEMO_BOX_REF (MAKMEMO_MOD_BOX (SCM_EXPANDED_MODULE_REF,
+ list_of_guile,
+ REF (exp, PRIMITIVE_REF, NAME),
+ SCM_BOOL_F));
case SCM_EXPANDED_LEXICAL_REF:
return MAKMEMO_LEX_REF (lookup (REF (exp, LEXICAL_REF, GENSYM), env));
@@ -384,30 +385,41 @@ memoize (SCM exp, SCM env)
memoize (REF (exp, LEXICAL_SET, EXP), env));
case SCM_EXPANDED_MODULE_REF:
- return MAKMEMO_MOD_REF (REF (exp, MODULE_REF, MOD),
- REF (exp, MODULE_REF, NAME),
- REF (exp, MODULE_REF, PUBLIC));
+ return MAKMEMO_BOX_REF (MAKMEMO_MOD_BOX
+ (SCM_EXPANDED_MODULE_REF,
+ REF (exp, MODULE_REF, MOD),
+ REF (exp, MODULE_REF, NAME),
+ REF (exp, MODULE_REF, PUBLIC)));
case SCM_EXPANDED_MODULE_SET:
- return MAKMEMO_MOD_SET (memoize (REF (exp, MODULE_SET, EXP), env),
- REF (exp, MODULE_SET, MOD),
- REF (exp, MODULE_SET, NAME),
- REF (exp, MODULE_SET, PUBLIC));
+ return MAKMEMO_BOX_SET (MAKMEMO_MOD_BOX
+ (SCM_EXPANDED_MODULE_SET,
+ REF (exp, MODULE_SET, MOD),
+ REF (exp, MODULE_SET, NAME),
+ REF (exp, MODULE_SET, PUBLIC)),
+ memoize (REF (exp, MODULE_SET, EXP), env));
case SCM_EXPANDED_TOPLEVEL_REF:
return maybe_makmemo_capture_module
- (MAKMEMO_TOP_REF (REF (exp, TOPLEVEL_REF, NAME)), env);
+ (MAKMEMO_BOX_REF (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_REF,
+ REF (exp, TOPLEVEL_REF, NAME))),
+ env);
case SCM_EXPANDED_TOPLEVEL_SET:
return maybe_makmemo_capture_module
- (MAKMEMO_TOP_SET (REF (exp, TOPLEVEL_SET, NAME),
+ (MAKMEMO_BOX_SET (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_SET,
+ REF (exp, TOPLEVEL_SET, NAME)),
memoize (REF (exp, TOPLEVEL_SET, EXP),
capture_env (env))),
env);
case SCM_EXPANDED_TOPLEVEL_DEFINE:
- return MAKMEMO_DEFINE (REF (exp, TOPLEVEL_DEFINE, NAME),
- memoize (REF (exp, TOPLEVEL_DEFINE, EXP), env));
+ return maybe_makmemo_capture_module
+ (MAKMEMO_BOX_SET (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_DEFINE,
+ REF (exp, TOPLEVEL_DEFINE, NAME)),
+ memoize (REF (exp, TOPLEVEL_DEFINE, EXP),
+ capture_env (env))),
+ env);
case SCM_EXPANDED_CONDITIONAL:
return MAKMEMO_IF (memoize (REF (exp, CONDITIONAL, TEST), env),
@@ -450,6 +462,14 @@ memoize (SCM exp, SCM env)
&& scm_is_eq (name,
scm_from_latin1_symbol ("call-with-values")))
return MAKMEMO_CALL_WITH_VALUES (CAR (args), CADR (args));
+ else if (nargs == 1
+ && scm_is_eq (name,
+ scm_from_latin1_symbol ("variable-ref")))
+ return MAKMEMO_BOX_REF (CAR (args));
+ else if (nargs == 2
+ && scm_is_eq (name,
+ scm_from_latin1_symbol ("variable-set!")))
+ return MAKMEMO_BOX_SET (CAR (args), CADR (args));
else if (nargs == 2
&& scm_is_eq (name, scm_from_latin1_symbol ("wind")))
return MAKMEMO_CALL (MAKMEMO_QUOTE (wind), 2, args);
@@ -464,11 +484,17 @@ memoize (SCM exp, SCM env)
return MAKMEMO_CALL (MAKMEMO_QUOTE (pop_fluid), 0, SCM_EOL);
else if (scm_is_eq (scm_current_module (), scm_the_root_module ()))
return MAKMEMO_CALL (maybe_makmemo_capture_module
- (MAKMEMO_TOP_REF (name), env),
+ (MAKMEMO_BOX_REF
+ (MAKMEMO_TOP_BOX (SCM_EXPANDED_TOPLEVEL_REF,
+ name)),
+ env),
nargs, args);
else
- return MAKMEMO_CALL (MAKMEMO_MOD_REF (list_of_guile, name,
- SCM_BOOL_F),
+ return MAKMEMO_CALL (MAKMEMO_BOX_REF
+ (MAKMEMO_MOD_BOX (SCM_EXPANDED_MODULE_REF,
+ list_of_guile,
+ name,
+ SCM_BOOL_F)),
nargs,
args);
}
@@ -478,35 +504,15 @@ memoize (SCM exp, SCM env)
memoize (REF (exp, SEQ, TAIL), env));
case SCM_EXPANDED_LAMBDA:
- /* The body will be a lambda-case or #f. */
+ /* The body will be a lambda-case. */
{
SCM meta, body, proc, new_env;
meta = REF (exp, LAMBDA, META);
body = REF (exp, LAMBDA, BODY);
new_env = push_flat_link (capture_env (env));
-
- if (scm_is_false (body))
- /* Give a body to case-lambda with no clauses. */
- proc = MAKMEMO_LAMBDA
- (MAKMEMO_CALL
- (MAKMEMO_MOD_REF (list_of_guile,
- scm_from_latin1_symbol ("throw"),
- SCM_BOOL_F),
- 5,
- scm_list_5 (MAKMEMO_QUOTE (scm_args_number_key),
- MAKMEMO_QUOTE (SCM_BOOL_F),
- MAKMEMO_QUOTE (scm_from_latin1_string
- ("Wrong number of arguments")),
- MAKMEMO_QUOTE (SCM_EOL),
- MAKMEMO_QUOTE (SCM_BOOL_F))),
- FIXED_ARITY (0),
- meta);
- else
- {
- proc = memoize (body, new_env);
- SCM_SETCAR (SCM_CDR (SCM_MEMOIZED_ARGS (proc)), meta);
- }
+ proc = memoize (body, new_env);
+ SCM_SETCAR (SCM_CDR (SCM_MEMOIZED_ARGS (proc)), meta);
return maybe_makmemo_capture_module (capture_flat_env (proc, new_env),
env);
@@ -677,8 +683,6 @@ unmemoize (const SCM expr)
case SCM_M_CALL_WITH_VALUES:
return scm_list_3 (scm_from_latin1_symbol ("call-with-values"),
unmemoize (CAR (args)), unmemoize (CDR (args)));
- case SCM_M_DEFINE:
- return scm_list_3 (scm_sym_define, CAR (args), unmemoize (CDR (args)));
case SCM_M_CAPTURE_MODULE:
return scm_list_2 (scm_from_latin1_symbol ("capture-module"),
unmemoize (args));
@@ -738,23 +742,18 @@ unmemoize (const SCM expr)
case SCM_M_LEXICAL_SET:
return scm_list_3 (scm_sym_set_x, unmemoize_lexical (CAR (args)),
unmemoize (CDR (args)));
- case SCM_M_TOPLEVEL_REF:
- return args;
- case SCM_M_TOPLEVEL_SET:
- return scm_list_3 (scm_sym_set_x, CAR (args), unmemoize (CDR (args)));
- case SCM_M_MODULE_REF:
- return SCM_VARIABLEP (args) ? args
+ case SCM_M_BOX_REF:
+ return scm_list_2 (scm_from_latin1_symbol ("variable-ref"),
+ unmemoize (args));
+ case SCM_M_BOX_SET:
+ return scm_list_3 (scm_from_latin1_symbol ("variable-set!"),
+ unmemoize (CAR (args)),
+ unmemoize (CDR (args)));
+ case SCM_M_RESOLVE:
+ return (SCM_VARIABLEP (args) || scm_is_symbol (args)) ? args
: scm_list_3 (scm_is_true (CDDR (args)) ? scm_sym_at : scm_sym_atat,
scm_i_finite_list_copy (CAR (args)),
CADR (args));
- case SCM_M_MODULE_SET:
- return scm_list_3 (scm_sym_set_x,
- SCM_VARIABLEP (CDR (args)) ? CDR (args)
- : scm_list_3 (scm_is_true (CDDDR (args))
- ? scm_sym_at : scm_sym_atat,
- scm_i_finite_list_copy (CADR (args)),
- CADDR (args)),
- unmemoize (CAR (args)));
case SCM_M_CALL_WITH_PROMPT:
return scm_list_4 (scm_from_latin1_symbol ("call-with-prompt"),
unmemoize (CAR (args)),
@@ -802,78 +801,53 @@ static void error_unbound_variable (SCM symbol)
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_memoize_variable_access_x
+SCM_DEFINE (scm_sys_resolve_variable, "%resolve-variable", 2, 0, 0,
+ (SCM loc, SCM mod),
+ "Look up and return the variable for @var{loc}.")
+#define FUNC_NAME s_scm_sys_resolve_variable
{
- SCM mx = SCM_MEMOIZED_ARGS (m);
+ int mode;
if (scm_is_false (mod))
mod = scm_the_root_module ();
- 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_SETCDR (m, var);
- return var;
- }
+ mode = scm_to_int (scm_car (loc));
+ loc = scm_cdr (loc);
- case SCM_M_TOPLEVEL_SET:
+ switch (mode)
+ {
+ case SCM_EXPANDED_TOPLEVEL_REF:
+ case SCM_EXPANDED_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;
- }
+ SCM var = scm_module_variable (mod, loc);
+ if (scm_is_false (var)
+ || (mode == SCM_EXPANDED_TOPLEVEL_REF
+ && scm_is_false (scm_variable_bound_p (var))))
+ error_unbound_variable (loc);
+ 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_SETCDR (m, var);
- return var;
- }
+ case SCM_EXPANDED_TOPLEVEL_DEFINE:
+ {
+ return scm_module_ensure_local_variable (mod, loc);
+ }
- 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;
- }
+ case SCM_EXPANDED_MODULE_REF:
+ case SCM_EXPANDED_MODULE_SET:
+ {
+ SCM var;
+ mod = scm_resolve_module (scm_car (loc));
+ if (scm_is_true (scm_cddr (loc)))
+ mod = scm_module_public_interface (mod);
+ var = scm_module_lookup (mod, scm_cadr (loc));
+ if (mode == SCM_EXPANDED_MODULE_SET
+ && scm_is_false (scm_variable_bound_p (var)))
+ error_unbound_variable (scm_cadr (loc));
+ return var;
+ }
default:
- scm_wrong_type_arg (FUNC_NAME, 1, m);
+ scm_wrong_type_arg (FUNC_NAME, 1, loc);
return SCM_BOOL_F;
}
}
diff --git a/libguile/memoize.h b/libguile/memoize.h
index f0dab5797..23c030674 100644
--- a/libguile/memoize.h
+++ b/libguile/memoize.h
@@ -69,7 +69,6 @@ enum
SCM_M_CAPTURE_ENV,
SCM_M_LET,
SCM_M_QUOTE,
- SCM_M_DEFINE,
SCM_M_CAPTURE_MODULE,
SCM_M_APPLY,
SCM_M_CONT,
@@ -77,10 +76,9 @@ enum
SCM_M_CALL,
SCM_M_LEXICAL_REF,
SCM_M_LEXICAL_SET,
- SCM_M_TOPLEVEL_REF,
- SCM_M_TOPLEVEL_SET,
- SCM_M_MODULE_REF,
- SCM_M_MODULE_SET,
+ SCM_M_BOX_REF,
+ SCM_M_BOX_SET,
+ SCM_M_RESOLVE,
SCM_M_CALL_WITH_PROMPT
};
@@ -90,7 +88,7 @@ enum
SCM_INTERNAL SCM scm_memoize_expression (SCM exp);
SCM_INTERNAL SCM scm_unmemoize_expression (SCM memoized);
SCM_INTERNAL SCM scm_memoized_typecode (SCM sym);
-SCM_INTERNAL SCM scm_memoize_variable_access_x (SCM memoized, SCM module);
+SCM_INTERNAL SCM scm_sys_resolve_variable (SCM loc, SCM module);
SCM_INTERNAL void scm_init_memoize (void);
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index aa1ab2e0a..f3f08992a 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -463,11 +463,15 @@
(let ((proc (eval f env)))
(call eval proc nargs args env)))
- (('toplevel-ref var-or-sym)
- (variable-ref
- (if (variable? var-or-sym)
- var-or-sym
- (memoize-variable-access! exp (env-toplevel env)))))
+ (('box-ref box)
+ (variable-ref (eval box env)))
+
+ (('resolve var-or-loc)
+ (if (variable? var-or-loc)
+ var-or-loc
+ (let ((var (%resolve-variable var-or-loc (env-toplevel env))))
+ (set-cdr! exp var)
+ var)))
(('if (test consequent . alternate))
(if (eval test env)
@@ -515,6 +519,9 @@
(eval head env)
(eval tail env)))
+ (('box-set! (box . val))
+ (variable-set! (eval box env) (eval val env)))
+
(('lexical-set! ((depth . width) . x))
(env-set! env depth width (eval x env)))
@@ -525,27 +532,9 @@
(('apply (f args))
(apply (eval f env) (eval args env)))
- (('module-ref var-or-spec)
- (variable-ref
- (if (variable? var-or-spec)
- var-or-spec
- (memoize-variable-access! exp #f))))
-
- (('define (name . x))
- (begin
- (define! name (eval x env))
- (if #f #f)))
-
(('capture-module x)
(eval x (current-module)))
- (('toplevel-set! (var-or-sym . x))
- (variable-set!
- (if (variable? var-or-sym)
- var-or-sym
- (memoize-variable-access! exp (env-toplevel env)))
- (eval x env)))
-
(('call-with-prompt (tag thunk . handler))
(call-with-prompt
(eval tag env)
@@ -553,14 +542,7 @@
(eval handler env)))
(('call/cc proc)
- (call/cc (eval proc env)))
-
- (('module-set! (x . var-or-spec))
- (variable-set!
- (if (variable? var-or-spec)
- var-or-spec
- (memoize-variable-access! exp #f))
- (eval x env)))))
+ (call/cc (eval proc env)))))
;; primitive-eval
(lambda (exp)