1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00

r6rs `import' accepts multiple clauses

* module/ice-9/r6rs-libraries.scm (import): Accept multiple clauses.

* test-suite/tests/rnrs-libraries.test: Add test.
This commit is contained in:
Andy Wingo 2010-06-09 08:55:02 +02:00
parent a4082ab57e
commit ffd48603b0
2 changed files with 23 additions and 10 deletions

View file

@ -190,13 +190,19 @@
(define-syntax import (define-syntax import
(lambda (stx) (lambda (stx)
(syntax-case stx (for) (define (strip-for import-set)
((_ (for import-set import-level ...)) (syntax-case import-set (for)
#'(import import-set)) ((for import-set import-level ...)
((_ import-set) #'import-set)
(import-set
#'import-set)))
(syntax-case stx ()
((_ import-set ...)
(with-syntax (((library-reference ...) (map strip-for #'(import-set ...))))
#'(eval-when (eval load compile expand) #'(eval-when (eval load compile expand)
(let ((iface (resolve-r6rs-interface 'import-set))) (let ((iface (resolve-r6rs-interface 'library-reference)))
(call-with-deferred-observers (call-with-deferred-observers
(lambda () (lambda ()
(module-use-interfaces! (current-module) (list iface)))) (module-use-interfaces! (current-module) (list iface)))))
...
(if #f #f))))))) (if #f #f)))))))

View file

@ -183,4 +183,11 @@
(with-test-prefix "srfi" (with-test-prefix "srfi"
(pass-if "renaming works" (pass-if "renaming works"
(eq? (resolve-interface '(srfi srfi-1)) (eq? (resolve-interface '(srfi srfi-1))
(resolve-r6rs-interface '(srfi :1)))))) (resolve-r6rs-interface '(srfi :1)))))
(with-test-prefix "macro"
(pass-if "multiple clauses"
(eval '(begin
(import (rnrs) (for (rnrs) expand) (rnrs))
#t)
(current-module)))))