fix defmacro*

* module/ice-9/optargs.scm (defmacro*): Fix implementation -- defmacro*
  takes Lisp-like arguments.
  (defmacro*-public): Fix also, expanding into defmacro*.

* THANKS: Thanks to Tristan Colgate for the report.

* test-suite/tests/optargs.test: Add defmacro* tests.

THANKS

@@ -31,6 +31,7 @@ For fixes or providing information which led to a fix:
          Adrian Bunk
         Michael Carmack
               R Clayton
+        Tristan Colgate
         Stephen Compall
           Brian Crowder
     Christopher Cramer

module/ice-9/optargs.scm

@@ -269,14 +269,17 @@
 ;;   (defmacro* transmorgify (a #:optional b)
 
 (define-syntax defmacro*
-  (syntax-rules ()
-    ((_ (id . args) b0 b1 ...)
-     (defmacro id (lambda* args b0 b1 ...)))))
+  (lambda (x)
+    (syntax-case x ()
+      ((_ id args doc b0 b1 ...) (string? (syntax->datum #'doc))
+       #'(define-macro id doc (lambda* args b0 b1 ...)))
+      ((_ id args b0 b1 ...) 
+       #'(define-macro id #f (lambda* args b0 b1 ...))))))
 (define-syntax defmacro*-public
   (syntax-rules ()
-    ((_ (id . args) b0 b1 ...)
+    ((_ id args b0 b1 ...)
      (begin
-       (defmacro id (lambda* args b0 b1 ...))
+       (defmacro* id args b0 b1 ...)
        (export-syntax id)))))
 
 ;;; Support for optional & keyword args with the interpreter.

test-suite/tests/optargs.test

@@ -173,3 +173,18 @@
     (let ((f (lambda* (#:key x y z #:rest r) (list x y z r))))
       (equal? (f 1 2 3 #:x 'x #:z 'z)
               '(x #f z (1 2 3 #:x x #:z z))))))
+
+(with-test-prefix/c&e "defmacro*"
+  (pass-if "definition"
+    (begin
+      (defmacro* transmogrify (a #:optional (b 10))
+        `(,a ,b))
+      #t))
+  
+  (pass-if "explicit arg"
+    (equal? (transmogrify quote 5)
+            5))
+
+  (pass-if "default arg"
+    (equal? (transmogrify quote)
+            10)))