~ chicken-core (chicken-5) 6913ac9e4176743156da313ca72a5a7835682b29


commit 6913ac9e4176743156da313ca72a5a7835682b29
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Mon Apr 4 20:31:21 2016 +1200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Apr 4 20:31:21 2016 +1200

    Remove define-macro style define-syntax in normal syntax definitions
    
    As with 5d4f12e but for "normal" define-syntax forms (i.e. not those in
    a sequence of internal definitions).

diff --git a/NEWS b/NEWS
index 018145bb..9b813ba5 100644
--- a/NEWS
+++ b/NEWS
@@ -31,8 +31,8 @@
   - Added support for list-style library names.
 
 - Syntax expander
-  - Removed support for (define-syntax (foo e r c) ...) inside lambdas,
-    which was undocumented and not officially supported anyway.
+  - Removed support for (define-syntax (foo e r c) ...), which was
+    undocumented and not officially supported anyway.
 
 4.10.2
 
diff --git a/expand.scm b/expand.scm
index 18e3599c..88a0798f 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1056,26 +1056,14 @@
    '()
    (##sys#er-transformer
     (lambda (form r c)
+      (##sys#check-syntax 'define-syntax form '(_ symbol _))
       (let ((head (cadr form))
-	    (body (cddr form)) )
-	(cond ((not (pair? head))
-	       (##sys#check-syntax 'define-syntax head 'symbol)
-	       (##sys#check-syntax 'define-syntax body '#(_ 1))
-               (let ((name (or (getp head '##core#macro-alias) head)))
-                 (##sys#register-export name (##sys#current-module)))
-	       (when (c (r 'define-syntax) head)
-		 (chicken.expand#defjam-error form))
-	       `(##core#define-syntax ,head ,(car body)))
-	      (else			; DEPRECATED
-	       (##sys#check-syntax 'define-syntax head '(_ . lambda-list))
-	       (##sys#check-syntax 'define-syntax body '#(_ 1))
-	       (when (eq? (car form) (car head))
-		 (##sys#syntax-error-hook
-		  "redefinition of `define-syntax' not allowed in syntax-definition"
-		  form))
-	       `(##core#define-syntax 
-		 ,(car head)
-		 (##sys#er-transformer (##core#lambda ,(cdr head) ,@body))))))))))
+	    (body (caddr form)))
+	(let ((name (or (getp head '##core#macro-alias) head)))
+	  (##sys#register-export name (##sys#current-module)))
+	(when (c (r 'define-syntax) head)
+	  (chicken.expand#defjam-error form))
+	`(##core#define-syntax ,head ,body))))))
 
 (define (check-for-multiple-bindings bindings form loc)
   ;; assumes correct syntax
Trap