* libguile/eval.c (s_missing_expression, s_bad_variable): New static

identifiers.

	(scm_m_define): Use ASSERT_SYNTAX to signal syntax errors.  Prefer
	R5RS terminology for the naming of variables.  Be more specific
	about the kind of error that was detected.  Make sure file name,
	line number etc. are added to all freshly created expressions.
	Avoid unnecessary consing when creating the memoized code.

	* test-suite/tests/syntax.test (exception:missing-expr,
	exception:extra-expr): New.

	Adapted tests for 'begin' to the new way of error
	reporting.

libguile/ChangeLog

@@ -1,3 +1,14 @@
+2003-10-11  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	* eval.c (s_missing_expression, s_bad_variable): New static
+	identifiers.
+
+	(scm_m_define): Use ASSERT_SYNTAX to signal syntax errors.  Prefer
+	R5RS terminology for the naming of variables.  Be more specific
+	about the kind of error that was detected.  Make sure file name,
+	line number etc. are added to all freshly created expressions.
+	Avoid unnecessary consing when creating the memoized code.
+
 2003-10-11  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
 	* eval.c (s_extra_expression, s_misplaced_else_clause,

libguile/eval.c

@@ -100,6 +100,10 @@ char *alloca ();
  * expression is expected, a 'Bad expression' error is signalled.  */
 static const char s_bad_expression[] = "Bad expression";
 
+/* If a form is detected that holds less expressions than are required in that
+ * contect, a 'Missing expression' error is signalled.  */
+static const char s_missing_expression[] = "Missing expression in";
+
 /* If a form is detected that holds more expressions than are allowed in that
  * contect, an 'Extra expression' error is signalled.  */
 static const char s_extra_expression[] = "Extra expression in";
@@ -143,6 +147,10 @@ static const char s_bad_cond_clause[] = "Bad cond clause";
  * error is signalled.  */
 static const char s_missing_recipient[] = "Missing recipient in";
 
+/* If in a position where a variable name is required some other object is
+ * detected, a 'Bad variable' error is signalled.  */
+static const char s_bad_variable[] = "Bad variable";
+
 
 /* Signal a syntax error.  We distinguish between the form that caused the
  * error and the enclosing expression.  The error message will print out as
@@ -868,42 +876,60 @@ SCM_GLOBAL_SYMBOL(scm_sym_define, s_define);
 /* Dirk:FIXME:: We should provide an implementation for 'define' in the R5RS
  * module that does not implement this extension.  */
 SCM
-scm_m_define (SCM x, SCM env)
+scm_m_define (SCM expr, SCM env)
 {
-  SCM name;
-  x = SCM_CDR (x);
-  SCM_ASSYNT (scm_ilength (x) >= 2, s_expression, s_define);
-  name = SCM_CAR (x);
-  x = SCM_CDR (x);
-  while (SCM_CONSP (name))
+  SCM body;
+  SCM 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_missing_expression, expr);
+
+  body = SCM_CDR (cdr_expr);
+  variable = SCM_CAR (cdr_expr);
+  while (SCM_CONSP (variable))
     {
-      /* This while loop realizes function currying by variable nesting. */
-      SCM formals = SCM_CDR (name);
-      x = scm_list_1 (scm_cons2 (scm_sym_lambda, formals, x));
-      name = SCM_CAR (name);
+      /* This while loop realizes function currying by variable nesting.
+       * Variable is known to be a nested-variable.  In every iteration of the
+       * loop another level of lambda expression is created, starting with the
+       * innermost one.  */
+      const SCM formals = SCM_CDR (variable);
+      const SCM tail = scm_cons (formals, body);
+
+      /* Add source properties to each new lambda expression:  */
+      const SCM lambda = scm_cons_source (variable, scm_sym_lambda, tail);
+
+      body = scm_list_1 (lambda);
+      variable = SCM_CAR (variable);
     }
-  SCM_ASSYNT (SCM_SYMBOLP (name), s_variable, s_define);
-  SCM_ASSYNT (scm_ilength (x) == 1, s_expression, s_define);
+  ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
+  ASSERT_SYNTAX (scm_ilength (body) == 1, s_expression, expr);
+
   if (SCM_TOP_LEVEL (env))
     {
       SCM var;
-      x = scm_eval_car (x, env);
+      const SCM value = scm_eval_car (body, env);
       if (SCM_REC_PROCNAMES_P)
 	{
-	  SCM tmp = x;
+	  SCM tmp = value;
 	  while (SCM_MACROP (tmp))
 	    tmp = SCM_MACRO_CODE (tmp);
 	  if (SCM_CLOSUREP (tmp)
 	      /* Only the first definition determines the name. */
 	      && SCM_FALSEP (scm_procedure_property (tmp, scm_sym_name)))
-	    scm_set_procedure_property_x (tmp, scm_sym_name, name);
+	    scm_set_procedure_property_x (tmp, scm_sym_name, variable);
 	}
-      var = scm_sym2var (name, scm_env_top_level (env), SCM_BOOL_T);
-      SCM_VARIABLE_SET (var, x);
+      var = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_T);
+      SCM_VARIABLE_SET (var, value);
       return SCM_UNSPECIFIED;
     }
   else
-    return scm_cons2 (SCM_IM_DEFINE, name, x);
+    {
+      SCM_SETCAR (expr, SCM_IM_DEFINE);
+      SCM_SETCAR (cdr_expr, variable);
+      SCM_SETCDR (cdr_expr, body);
+      return expr;
+    }
 }
 
 

test-suite/ChangeLog

@@ -1,3 +1,11 @@
+2003-10-11  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	* tests/syntax.test (exception:missing-expr,
+	exception:extra-expr): New.
+
+	Adapted tests for 'begin' to the new way of error
+	reporting.
+
 2003-10-11  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
 	* tests/syntax.test (exception:misplaced-else-clause,

test-suite/tests/syntax.test

@@ -23,6 +23,14 @@
 
 (define exception:bad-expression
   (cons 'syntax-error "Bad expression"))
+
+(define exception:missing/extra-expr
+  (cons 'misc-error "^missing or extra expression"))
+(define exception:missing-expr
+  (cons 'syntax-error "Missing expression"))
+(define exception:extra-expr
+  (cons 'syntax-error "Extra expression"))
+
 (define exception:bad-bindings
   (cons 'misc-error "^bad bindings"))
 (define exception:duplicate-bindings
@@ -33,6 +41,7 @@
   (cons 'misc-error "^bad formals"))
 (define exception:duplicate-formals
   (cons 'misc-error "^duplicate formals"))
+
 (define exception:missing-clauses
   (cons 'syntax-error "Missing clauses"))
 (define exception:misplaced-else-clause
@@ -43,10 +52,9 @@
   (cons 'syntax-error "Bad case labels"))
 (define exception:bad-cond-clause
   (cons 'syntax-error "Bad cond clause"))
+
 (define exception:bad-var
   (cons 'misc-error "^bad variable"))
-(define exception:missing/extra-expr
-  (cons 'misc-error "^missing or extra expression"))
 
 
 (with-test-prefix "expressions"
@@ -590,7 +598,7 @@
   (with-test-prefix "missing or extra expressions"
 
     (pass-if-exception "(define)"
-      exception:missing/extra-expr
+      exception:missing-expr
       (eval '(define)
 	    (interaction-environment)))))