* 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.

libguile/ChangeLog

@@ -1,3 +1,24 @@
+2004-04-22  Dirk Herrmann  <dirk@dirk-herrmanns-seiten.de>
+
+	* 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.
+
+	* modules.c (module_variable): Return variables with unbound
+	value.
+
+	* tags.h: Fix comment.
+
 2004-04-25  Kevin Ryde  <user42@zip.com.au>
 
 	* chars.c (scm_char_upcase, scm_char_downcase, scm_c_upcase,
@@ -245,7 +266,6 @@
 
 	(copy_tree): Corrected typo in comment.
 
->>>>>>> 1.2042
 2004-03-28  Han-Wen Nienhuys   <hanwen@xs4all.nl>
 
 	* eval.c (s_scm_copy_tree): idem.

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);
           }

libguile/modules.c

@@ -277,7 +277,7 @@ static SCM
 module_variable (SCM module, SCM sym)
 {
 #define SCM_BOUND_THING_P(b) \
-  (SCM_VARIABLEP (b) && !SCM_UNBNDP (SCM_VARIABLE_REF (b)))
+  (!SCM_FALSEP (b))
 
   /* 1. Check module obarray */
   SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);

libguile/tags.h

@@ -325,8 +325,8 @@ typedef unsigned long scm_t_bits;
  * tc8 (for objects with tc3==100):
  *   00000-100:  special objects ('flags')
  *   00001-100:  characters
- *   00010-100:  evaluator byte codes ('ilocs')
- *   00011-100:  evaluator byte codes ('isyms')
+ *   00010-100:  evaluator byte codes ('isyms')
+ *   00011-100:  evaluator byte codes ('ilocs')
  *
  *
  * Summary of type codes on the heap

test-suite/ChangeLog

@@ -1,3 +1,8 @@
+2004-04-26  Dirk Herrmann  <dirk@dirk-herrmanns-seiten.de>
+
+	* tests/syntax.test: Add test case to check the correct handling
+	of define expressions.
+
 2004-04-25  Kevin Ryde  <user42@zip.com.au>
 
 	* tests/socket.test: New file, exercising inet-ntop.

test-suite/tests/syntax.test

@@ -592,6 +592,16 @@
 
 (with-test-prefix "top-level define"
 
+  (pass-if "binding is created before expression is evaluated"
+    (= (eval '(begin
+                (define foo
+                  (begin
+                    (set! foo 1)
+                    (+ foo 1)))
+                foo)
+             (interaction-environment))
+       2))
+
   (with-test-prefix "currying"
 
     (pass-if "(define ((foo)) #f)"