summaryrefslogtreecommitdiff
path: root/libguile/eval.c
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2004-04-26 19:59:03 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2004-04-26 19:59:03 +0000
commit36245b66c222110c84b04e14733614055dc36575 (patch)
tree883014b85dc7f93d5221c9a90bbd261f32a2303e /libguile/eval.c
parentda8bcb2f709cecc6fea17c2396541b1ab601755d (diff)
downloadguile-36245b66c222110c84b04e14733614055dc36575.tar.gz
* libguile/eval.c (s_macro_keyword): New static identifier.
(scm_m_define): Change order to first create binding and evaluating the expression afterwards. (scm_m_set_x): Memoize complete set! expression. Only leave symbols if no binding exists at memoization time. Throw error if assigning to a syntactic keyword. (lazy_memoize_variable): New function. (CEVAL): When execution set!, perform lazy memoization if unmemoized symbol is detected. * libguile/modules.c (module_variable): Return variables with unbound value. * libguile/tags.h: Fix comment. * test-suite/tests/syntax.test: Add test case to check the correct handling of define expressions.
Diffstat (limited to 'libguile/eval.c')
-rw-r--r--libguile/eval.c54
1 files changed, 45 insertions, 9 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index 7f34b74e8..83d2e5bcc 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -144,6 +144,10 @@ static const char s_mixed_body_forms[] = "Mixed definitions and expressions in";
* is signalled. */
static const char s_bad_define[] = "Bad define placement";
+/* If a macro keyword is detected in a place where macro keywords are not
+ * allowed, a 'Misplaced syntactic keyword' error is signalled. */
+static const char s_macro_keyword[] = "Misplaced syntactic keyword";
+
/* Case or cond expressions must have at least one clause. If a case or cond
* expression without any clauses is detected, a 'Missing clauses' error is
* signalled. */
@@ -1194,6 +1198,10 @@ canonicalize_define (const SCM expr)
return expr;
}
+/* According to section 5.2.1 of R5RS we first have to make sure that the
+ * variable is bound, and then perform the (set! variable expression)
+ * operation. This means, that within the expression we may already assign
+ * values to variable: (define foo (begin (set! foo 1) (+ foo 1))) */
SCM
scm_m_define (SCM expr, SCM env)
{
@@ -1203,10 +1211,10 @@ scm_m_define (SCM expr, SCM env)
const SCM canonical_definition = canonicalize_define (expr);
const SCM cdr_canonical_definition = SCM_CDR (canonical_definition);
const SCM variable = SCM_CAR (cdr_canonical_definition);
- const SCM body = SCM_CDR (cdr_canonical_definition);
- const SCM value = scm_eval_car (body, env);
+ const SCM location
+ = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_T);
+ const SCM value = scm_eval_car (SCM_CDR (cdr_canonical_definition), env);
- SCM var;
if (SCM_REC_PROCNAMES_P)
{
SCM tmp = value;
@@ -1218,8 +1226,7 @@ scm_m_define (SCM expr, SCM env)
scm_set_procedure_property_x (tmp, scm_sym_name, variable);
}
- var = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_T);
- SCM_VARIABLE_SET (var, value);
+ SCM_VARIABLE_SET (location, value);
return SCM_UNSPECIFIED;
}
@@ -1779,15 +1786,23 @@ SCM
scm_m_set_x (SCM expr, SCM env SCM_UNUSED)
{
SCM variable;
+ SCM new_variable;
const SCM cdr_expr = SCM_CDR (expr);
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr);
variable = SCM_CAR (cdr_expr);
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable) || SCM_VARIABLEP (variable),
- s_bad_variable, variable, expr);
+
+ /* Memoize the variable form. */
+ ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
+ new_variable = lookup_symbol (variable, env);
+ ASSERT_SYNTAX (!SCM_MACROP (new_variable), s_macro_keyword, variable);
+ /* Leave the memoization of unbound symbols to lazy memoization: */
+ if (SCM_UNBNDP (new_variable))
+ new_variable = variable;
SCM_SETCAR (expr, SCM_IM_SET_X);
+ SCM_SETCAR (cdr_expr, new_variable);
return expr;
}
@@ -2612,6 +2627,22 @@ static SCM deval (SCM x, SCM env);
SCM_REC_MUTEX (source_mutex);
+/* During execution, look up a symbol in the top level of the given local
+ * environment and return the corresponding variable object. If no binding
+ * for the symbol can be found, an 'Unbound variable' error is signalled. */
+static SCM
+lazy_memoize_variable (const SCM symbol, const SCM environment)
+{
+ const SCM top_level = scm_env_top_level (environment);
+ const SCM variable = scm_sym2var (symbol, top_level, SCM_BOOL_F);
+
+ if (SCM_FALSEP (variable))
+ error_unbound_variable (symbol);
+ else
+ return variable;
+}
+
+
SCM
scm_eval_car (SCM pair, SCM env)
{
@@ -3327,8 +3358,13 @@ dispatch:
location = scm_ilookup (variable, env);
else if (SCM_VARIABLEP (variable))
location = SCM_VARIABLE_LOC (variable);
- else /* (SCM_SYMBOLP (variable)) is known to be true */
- location = scm_lookupcar (x, env, 1);
+ else
+ {
+ /* (SCM_SYMBOLP (variable)) is known to be true */
+ variable = lazy_memoize_variable (variable, env);
+ SCM_SETCAR (x, variable);
+ location = SCM_VARIABLE_LOC (variable);
+ }
x = SCM_CDR (x);
*location = EVALCAR (x, env);
}