~ chicken-core (chicken-5) 351dd4c3f3f452f107bed9511530d1d26a77c8a8

commit 351dd4c3f3f452f107bed9511530d1d26a77c8a8
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Sep 15 10:14:07 2010 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Wed Sep 15 10:14:07 2010 +0200

    applied srfi-26 error-reporting patch by Peter Bex

diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index f97c22a1..f57ef506 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -986,6 +986,8 @@
     (let ((%<> (r '<>))
 	  (%<...> (r '<...>))
 	  (%apply (r 'apply)))
+      (when (null? (cdr form))
+        (syntax-error 'cut "you need to supply at least a procedure" form))
       (let loop ([xs (cdr form)] [vars '()] [vals '()] [rest #f])
 	(if (null? xs)
 	    (let ([rvars (reverse vars)]
@@ -999,7 +1001,12 @@
 	    (cond ((c %<> (car xs))
 		   (let ([v (r (gensym))])
 		     (loop (cdr xs) (cons v vars) (cons v vals) #f) ) )
-		  ((c %<...> (car xs)) (loop '() vars vals #t))
+		  ((c %<...> (car xs))
+                   (if (null? (cdr xs))
+                       (loop '() vars vals #t)
+                       (syntax-error 'cut
+                                     "tail patterns after <...> are not supported"
+                                     form)))
 		  (else (loop (cdr xs) vars (cons (car xs) vals) #f)) ) ) ) ) )))
 
 (##sys#extend-macro-environment
@@ -1010,6 +1017,8 @@
     (let ((%apply (r 'apply))
 	  (%<> (r '<>))
 	  (%<...> (r '<...>)))
+      (when (null? (cdr form))
+        (syntax-error 'cute "you need to supply at least a procedure" form))
       (let loop ([xs (cdr form)] [vars '()] [bs '()] [vals '()] [rest #f])
 	(if (null? xs)
 	    (let ([rvars (reverse vars)]
@@ -1025,7 +1034,12 @@
 	    (cond ((c %<> (car xs))
 		   (let ([v (r (gensym))])
 		     (loop (cdr xs) (cons v vars) bs (cons v vals) #f) ) )
-		  ((c %<...> (car xs)) (loop '() vars bs vals #t))
+		  ((c %<...> (car xs))
+                   (if (null? (cdr xs))
+                       (loop '() vars bs vals #t)
+                       (syntax-error 'cute
+                                     "tail patterns after <...> are not supported"
+                                     form)))
 		  (else 
 		   (let ([v (r (gensym))])
 		     (loop (cdr xs)