[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-45-gaac006d

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=aac006ddec98c96ac5d9e19bd28496f8ff95f0ae

The branch, master has been updated
       via  aac006ddec98c96ac5d9e19bd28496f8ff95f0ae (commit)
       via  a927454d25f17a3cfb5c130f26933a76a9a9060b (commit)
      from  b349875146af814dbeac07e96b043a3a3996b7cd (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit aac006ddec98c96ac5d9e19bd28496f8ff95f0ae
Author: Andy Wingo <address@hidden>
Date:   Mon Dec 28 11:47:17 2009 +0100

    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.

commit a927454d25f17a3cfb5c130f26933a76a9a9060b
Author: Andy Wingo <address@hidden>
Date:   Mon Dec 28 11:44:06 2009 +0100

    (syntax foo) -> #'foo in boot-9
    
    * module/ice-9/boot-9.scm: Change instances of (syntax foo) to use the
      reader macro #'.

-----------------------------------------------------------------------

Summary of changes:
 THANKS                        |    1 +
 module/ice-9/boot-9.scm       |   31 +++++++++++++++----------------
 module/ice-9/optargs.scm      |   13 ++++++++-----
 test-suite/tests/optargs.test |   15 +++++++++++++++
 4 files changed, 39 insertions(+), 21 deletions(-)

diff --git a/THANKS b/THANKS
index e507d73..9ffb0f0 100644
--- a/THANKS
+++ b/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
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 4bc1906..1fe1959 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -353,31 +353,30 @@
     "Define a defmacro."
     (syntax-case x ()
       ((_ (macro . args) doc body1 body ...)
-       (string? (syntax->datum (syntax doc)))
-       (syntax (define-macro macro doc (lambda args body1 body ...))))
+       (string? (syntax->datum #'doc))
+       #'(define-macro macro doc (lambda args body1 body ...)))
       ((_ (macro . args) body ...)
-       (syntax (define-macro macro #f (lambda args body ...))))
+       #'(define-macro macro #f (lambda args body ...)))
       ((_ macro doc transformer)
-       (or (string? (syntax->datum (syntax doc)))
-           (not (syntax->datum (syntax doc))))
-       (syntax
-        (define-syntax macro
-          (lambda (y)
-            doc
-            (syntax-case y ()
-              ((_ . args)
-               (let ((v (syntax->datum (syntax args))))
-                 (datum->syntax y (apply transformer v))))))))))))
+       (or (string? (syntax->datum #'doc))
+           (not (syntax->datum #'doc)))
+       #'(define-syntax macro
+           (lambda (y)
+             doc
+             (syntax-case y ()
+               ((_ . args)
+                (let ((v (syntax->datum #'args)))
+                  (datum->syntax y (apply transformer v)))))))))))
 
 (define-syntax defmacro
   (lambda (x)
     "Define a defmacro, with the old lispy defun syntax."
     (syntax-case x ()
       ((_ macro args doc body1 body ...)
-       (string? (syntax->datum (syntax doc)))
-       (syntax (define-macro macro doc (lambda args body1 body ...))))
+       (string? (syntax->datum #'doc))
+       #'(define-macro macro doc (lambda args body1 body ...)))
       ((_ macro args body ...)
-       (syntax (define-macro macro #f (lambda args body ...)))))))
+       #'(define-macro macro #f (lambda args body ...))))))
 
 (provide 'defmacro)
 
diff --git a/module/ice-9/optargs.scm b/module/ice-9/optargs.scm
index c9a0493..06e2a16 100644
--- a/module/ice-9/optargs.scm
+++ b/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.
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index 5eb8d48..a065261 100644
--- a/test-suite/tests/optargs.test
+++ b/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)))


hooks/post-receive
-- 
GNU Guile