* libguile/eval.c (s_bad_formals, s_bad_formal, s_duplicate_formal):

        New static identifiers.

	(s_clauses, s_formals, s_duplicate_formals): Removed.

	(scm_m_lambda): Use ASSERT_SYNTAX to signal syntax errors.  Be more
	specific about the kind of error that was detected.  Prepare for
	easier integration of changes for separated memoization.

	* test-suite/tests/syntax.test (define exception:bad-formal, define
	exception:duplicate-formal): New.

	(exception:duplicate-formals): Removed.

	(exception:bad-formals): Adapted to the new way of error
	reporting.

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

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 035308e..f12cb87 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,14 @@
+2003-10-12  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+       * eval.c (s_bad_formals, s_bad_formal, s_duplicate_formal): New
+       static identifiers.
+
+       (s_clauses, s_formals, s_duplicate_formals): Removed.
+
+       (scm_m_lambda): Use ASSERT_SYNTAX to signal syntax errors.  Be more
+       specific about the kind of error that was detected.  Prepare for
+       easier integration of changes for separated memoization.
+
 2003-10-11  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
        * eval.c (s_duplicate_binding): New static identifier.

diff --git a/libguile/eval.c b/libguile/eval.c
index 43f270c..d929964 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -173,6 +173,20 @@ static const char s_duplicate_binding[] = "Duplicate binding";
  * a 'Bad exit clause' error is signalled.  */
 static const char s_bad_exit_clause[] = "Bad exit clause";
 
+/* The formal function arguments of a lambda expression have to be either a
+ * single symbol or a non-cyclic list.  For anything else a 'Bad formals'
+ * error is signalled.  */
+static const char s_bad_formals[] = "Bad formals";
+
+/* If in a lambda expression something else than a symbol is detected at a
+ * place where a formal function argument is required, a 'Bad formal' error is
+ * signalled.  */
+static const char s_bad_formal[] = "Bad formal";
+
+/* If in the arguments list of a lambda expression an argument name occurs
+ * more than once, a 'Duplicate formal' error is signalled.  */
+static const char s_duplicate_formal[] = "Duplicate formal";
+
 
 /* Signal a syntax error.  We distinguish between the form that caused the
  * error and the enclosing expression.  The error message will print out as
@@ -382,9 +396,6 @@ static const char s_body[] = "bad body";
 static const char s_bindings[] = "bad bindings";
 static const char s_duplicate_bindings[] = "duplicate bindings";
 static const char s_variable[] = "bad variable";
-static const char s_clauses[] = "bad or missing clauses";
-static const char s_formals[] = "bad formals";
-static const char s_duplicate_formals[] = "duplicate formals";
 static const char s_splicing[] = "bad (non-list) result for unquote-splicing";
 
 
@@ -1098,27 +1109,47 @@ c_improper_memq (SCM obj, SCM list)
 }
 
 SCM
-scm_m_lambda (SCM xorig, SCM env SCM_UNUSED)
+scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
 {
   SCM formals;
-  SCM x = SCM_CDR (xorig);
+  SCM formals_idx;
+
+  const SCM cdr_expr = SCM_CDR (expr);
+  const long length = scm_ilength (cdr_expr);
+  ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
+  ASSERT_SYNTAX (length >= 2, s_missing_expression, expr);
 
-  SCM_ASSYNT (SCM_CONSP (x), s_formals, s_lambda);
+  /* Before iterating the list of formal arguments, make sure the formals
+   * actually are given as either a symbol or a non-cyclic list.  */
+  formals = SCM_CAR (cdr_expr);
+  if (SCM_CONSP (formals))
+    {
+      /* Dirk:FIXME:: We should check for a cyclic list of formals, and if
+       * detected, report a 'Bad formals' error.  */
+    }
+  else
+    {
+      ASSERT_SYNTAX_2 (SCM_SYMBOLP (formals) || SCM_NULLP (formals),
+                       s_bad_formals, formals, expr);
+    }
 
-  formals = SCM_CAR (x);
-  while (SCM_CONSP (formals))
+  /* Now iterate the list of formal arguments to check if all formals are
+   * symbols, and that there are no duplicates.  */
+  formals_idx = formals;
+  while (SCM_CONSP (formals_idx))
     {
-      SCM formal = SCM_CAR (formals);
-      SCM_ASSYNT (SCM_SYMBOLP (formal), s_formals, s_lambda);
-      if (c_improper_memq (formal, SCM_CDR (formals)))
-       scm_misc_error (s_lambda, s_duplicate_formals, SCM_EOL);
-      formals = SCM_CDR (formals);
+      const SCM formal = SCM_CAR (formals_idx);
+      const SCM next_idx = SCM_CDR (formals_idx);
+      ASSERT_SYNTAX_2 (SCM_SYMBOLP (formal), s_bad_formal, formal, expr);
+      ASSERT_SYNTAX_2 (!c_improper_memq (formal, next_idx),
+                       s_duplicate_formal, formal, expr);
+      formals_idx = next_idx;
     }
-  if (!SCM_NULLP (formals) && !SCM_SYMBOLP (formals))
-    scm_misc_error (s_lambda, s_formals, SCM_EOL);
+  ASSERT_SYNTAX_2 (SCM_NULLP (formals_idx) || SCM_SYMBOLP (formals_idx),
+                   s_bad_formal, formals_idx, expr);
 
-  return scm_cons2 (SCM_IM_LAMBDA, SCM_CAR (x),
-                   scm_m_body (SCM_IM_LAMBDA, SCM_CDR (x), s_lambda));
+  return scm_cons2 (SCM_IM_LAMBDA, SCM_CAR (cdr_expr),
+                   scm_m_body (SCM_IM_LAMBDA, SCM_CDR (cdr_expr), s_lambda));
 }
 
 

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index ca44821..f4deb83 100644 (file)
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,3 +1,15 @@
+2003-10-12  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+       * tests/syntax.test (define exception:bad-formal, define
+       exception:duplicate-formal): New.
+
+       (exception:duplicate-formals): Removed.
+
+       (exception:bad-formals): Adapted to the new way of error
+       reporting.
+
+       Adapted tests for 'lambda' to the new way of error reporting.
+
 2003-10-11  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
        * tests/syntax.test (exception:missing/extra-expr-syntax): Fixed

diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index 58fbc7f..9bde520 100644 (file)
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -40,9 +40,11 @@
 (define exception:bad-body
   (cons 'misc-error "^bad body"))
 (define exception:bad-formals
-  (cons 'misc-error "^bad formals"))
-(define exception:duplicate-formals
-  (cons 'misc-error "^duplicate formals"))
+  (cons 'syntax-error "Bad formals"))
+(define exception:bad-formal
+  (cons 'syntax-error "Bad formal"))
+(define exception:duplicate-formal
+  (cons 'syntax-error "Duplicate formal"))
 
 (define exception:missing-clauses
   (cons 'syntax-error "Missing clauses"))
@@ -122,17 +124,17 @@
   (with-test-prefix "bad formals"
 
     (pass-if-exception "(lambda)"
-      exception:bad-formals
+      exception:missing-expr
       (eval '(lambda)
            (interaction-environment)))
 
     (pass-if-exception "(lambda . \"foo\")"
-      exception:bad-formals
+      exception:bad-expression
       (eval '(lambda . "foo")
            (interaction-environment)))
 
     (pass-if-exception "(lambda \"foo\")"
-      exception:bad-formals
+      exception:missing-expr
       (eval '(lambda "foo")
            (interaction-environment)))
 
@@ -142,22 +144,22 @@
            (interaction-environment)))
 
     (pass-if-exception "(lambda (x 1) 2)"
-      exception:bad-formals
+      exception:bad-formal
       (eval '(lambda (x 1) 2)
            (interaction-environment)))
 
     (pass-if-exception "(lambda (1 x) 2)"
-      exception:bad-formals
+      exception:bad-formal
       (eval '(lambda (1 x) 2)
            (interaction-environment)))
 
     (pass-if-exception "(lambda (x \"a\") 2)"
-      exception:bad-formals
+      exception:bad-formal
       (eval '(lambda (x "a") 2)
            (interaction-environment)))
 
     (pass-if-exception "(lambda (\"a\" x) 2)"
-      exception:bad-formals
+      exception:bad-formal
       (eval '(lambda ("a" x) 2)
            (interaction-environment))))
 
@@ -165,20 +167,20 @@
 
     ;; Fixed on 2001-3-3
     (pass-if-exception "(lambda (x x) 1)"
-      exception:duplicate-formals
+      exception:duplicate-formal
       (eval '(lambda (x x) 1)
            (interaction-environment)))
 
     ;; Fixed on 2001-3-3
     (pass-if-exception "(lambda (x x x) 1)"
-      exception:duplicate-formals
+      exception:duplicate-formal
       (eval '(lambda (x x x) 1)
            (interaction-environment))))
 
   (with-test-prefix "bad body"
 
     (pass-if-exception "(lambda ())"
-      exception:bad-body
+      exception:missing-expr
       (eval '(lambda ())
            (interaction-environment)))))