mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

fix defmacro*

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2009-12-28 11:47:17 +01:00
parent a927454d25
commit aac006ddec
3 changed files with 24 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

1
THANKS
View file

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

13
module/ice-9/optargs.scm
View file

@ -269,14 +269,17 @@
;; (defmacro* transmorgify (a #:optional b) ;; (defmacro* transmorgify (a #:optional b)
(define-syntax defmacro* (define-syntax defmacro*
(syntax-rules () (lambda (x)
((_ (id . args) b0 b1 ...) (syntax-case x ()
(defmacro id (lambda* args b0 b1 ...))))) ((_ 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 (define-syntax defmacro*-public
(syntax-rules () (syntax-rules ()
((_ (id . args) b0 b1 ...) ((_ id args b0 b1 ...)
(begin (begin
(defmacro id (lambda* args b0 b1 ...)) (defmacro* id args b0 b1 ...)
(export-syntax id))))) (export-syntax id)))))
;;; Support for optional & keyword args with the interpreter. ;;; Support for optional & keyword args with the interpreter.

15
test-suite/tests/optargs.test
View file

@ -173,3 +173,18 @@
(let ((f (lambda* (#:key x y z #:rest r) (list x y z r)))) (let ((f (lambda* (#:key x y z #:rest r) (list x y z r))))
(equal? (f 1 2 3 #:x 'x #:z 'z) (equal? (f 1 2 3 #:x 'x #:z 'z)
'(x #f z (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)))