Package: guile;
Reported by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Date: Thu, 23 Nov 2023 19:46:01 UTC
Severity: normal
To reply to this bug, email your comments to 67412 AT debbugs.gnu.org.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
bug-guile <at> gnu.org:bug#67412; Package guile.
(Thu, 23 Nov 2023 19:46:02 GMT) Full text and rfc822 format available.Maxim Cournoyer <maxim.cournoyer <at> gmail.com>:bug-guile <at> gnu.org.
(Thu, 23 Nov 2023 19:46:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: bug-guile <bug-guile <at> gnu.org> Subject: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160) Date: Thu, 23 Nov 2023 14:45:23 -0500
Hello,
While working on integrating SRFI 178, I've encountered the following
problem:
--8<---------------cut here---------------start------------->8---
Backtrace:
In system/base/compile.scm:
53:4 19 (call-once #<procedure 7f77d26e94c0 at system/base/comp?>)
In ice-9/boot-9.scm:
1755:12 18 (with-exception-handler #<procedure 7f77d65faf00 at ic?> ?)
In system/base/compile.scm:
69:11 17 (_)
190:11 16 (_ #<closed: file 7f77d35f78c0>)
309:6 15 (read-and-compile #<input: srfi/srfi-178.sld 15> #:from ?)
331:39 14 (with-compiler #<<language> name: scheme title: "Schem?> ?)
261:27 13 (_ #<syntax:srfi-178.sld:1:0 (#<syntax:srfi-178.sld:1:?> ?)
In ice-9/boot-9.scm:
2919:4 12 (save-module-excursion #<procedure 7f77d660c200 at lang?>)
In language/scheme/compile-tree-il.scm:
31:15 11 (_)
In ice-9/psyntax.scm:
1229:36 10 (expand-top-sequence (#<syntax:srfi-178.sld:1:0 (#<sy?>) ?)
1121:20 9 (lp (#<syntax:srfi-178.sld:1:0 (#<syntax:srfi-178.sld?>) ?)
1342:32 8 (syntax-type (#<syntax:r6rs-libraries.scm:291:12 li?> ?) ?)
1562:32 7 (expand-macro #<procedure 7f77d64d1d30 at ice-9/r6rs-l?> ?)
In ice-9/r6rs-libraries.scm:
304:14 6 (_ #<syntax:r6rs-libraries.scm:291:21 srfi> (#<syntax?>) ?)
In ice-9/boot-9.scm:
222:29 5 (map1 (#<syntax:srfi-178.sld:2:10 (#<syntax:srfi-178?> ?))
222:29 4 (map1 (#<syntax:srfi-178.sld:3:10 (#<syntax:srfi-178?> ?))
222:29 3 (map1 (#<syntax:srfi-178.sld:4:10 (#<syntax:srfi-178?> ?))
222:17 2 (map1 (#<syntax:srfi-178.sld:5:10 (#<syntax:srfi-178.s?>))
3413:6 1 (resolve-interface (srfi srfi-160) #:select _ #:hide _ # ?)
1676:22 0 (lp 0)
ice-9/boot-9.scm:1676:22: In procedure lp:
no code for module (srfi srfi-160)
--8<---------------cut here---------------end--------------->8---
Indeed, there's no such (srfi 160) module in SRFI 160, but why is it
loaded in the first place? My srfi-178.sld R7RS library imports:
--8<---------------cut here---------------start------------->8---
(define-library (srfi 178)
(import (scheme base))
(import (scheme case-lambda))
(import (srfi 151))
(import (srfi 160 u8))
...
--8<---------------cut here---------------end--------------->8---
There seems to be something that doesn't work as expected in the (ice-9
r6rs-libraries) module:
--8<---------------cut here---------------start------------->8---
(resolve-r6rs-interface '(srfi 160 u8))
ERROR: no code for module (srfi srfi-160)
--8<---------------cut here---------------end--------------->8---
(srfi 160) should not be loaded; it's (srfi 160 u8) that is requested.
--
Thanks,
Maxim
bug-guile <at> gnu.org:bug#67412; Package guile.
(Thu, 23 Nov 2023 21:46:03 GMT) Full text and rfc822 format available.Message #8 received at 67412 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 67412 <at> debbugs.gnu.org Subject: Re: bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160) Date: Thu, 23 Nov 2023 16:44:54 -0500
Hi,
Investigating, I've found this:
--8<---------------cut here---------------start------------->8---
trace: | (_ #<procedure 7fc0c55af068 at ice-9/r6rs-libraries.scm:104:5 (n rest version)> (160 (u8) ()))
trace: | (_ 160 (u8) ())
trace: | | (syntax->datum 160)
trace: | | (strip 160)
trace: | | | (syntax? 160)
trace: | | | #f
trace: | | 160
trace: | | (number->string 160)
trace: | | "160"
trace: | | (string-append "srfi-" "160")
trace: | | "srfi-160"
trace: | | (datum->syntax #<syntax:r6rs-libraries.scm:92:34 srfi> srfi-160)
trace: | | | (syntax-wrap #<syntax:r6rs-libraries.scm:92:34 srfi>)
trace: | | | ((top) #(ribcage #(n rest version) #((top) (top) (top)) #("l-680b775fb37a463-160b" "l-680b775fb37a463-160c" "l-680b775fb37a463-160d")) #(ribcage (module-for-each/nonlocal # make-srfi-n # …) …) …)
trace: | | | (syntax-module #<syntax:r6rs-libraries.scm:92:34 srfi>)
trace: | | | (hygiene guile)
trace: | | | (source-properties srfi-160)
trace: | | | ()
trace: | | (make-syntax srfi-160 ((top) #(ribcage #(n rest version) #((top) (top) (top)) #("l-680b775fb37a463-160b" "l-680b775fb37a463-160c" "l-680b775fb37a463-160d")) #(ribcage (# # make-srfi-n # # …) …) …) …)
trace: | | #<syntax srfi-160>
trace: | | ($sc-dispatch (u8) ())
trace: | | | (syntax? (u8))
trace: | | | #f
trace: | | (match* (u8) () (()) () #f)
trace: | | #f
trace: | | ($sc-dispatch (u8) (any . each-any))
trace: | | | (syntax? (u8))
trace: | | | #f
trace: | | (match* (u8) (any . each-any) (()) () #f)
trace: | | | (match () each-any (()) () #f)
trace: | | | | (syntax? ())
trace: | | | | #f
trace: | | | (match* () each-any (()) () #f)
trace: | | | | (match-each-any () (()) #f)
trace: | | | | ()
trace: | | | (())
trace: | | (match u8 any (()) (()) #f)
trace: | | | (source-wrap u8 (()) #f #f)
trace: | | | u8
trace: | | (u8 ())
trace: | | (_ #<procedure 7fc0c108e1e0 at ice-9/r6rs-libraries.scm:93:7 (name rest)> (u8 ()))
trace: | | (_ u8 ())
trace: | | | (append () (()))
trace: | | | (())
--8<---------------cut here---------------end--------------->8---
This corresponds to this source:
--8<---------------cut here---------------start------------->8---
(syntax-case import-spec (library only except prefix rename srfi)
;; (srfi :n ...) -> (srfi srfi-n ...)
;; (srfi n ...) -> (srfi srfi-n ...)
((library (srfi n rest ... (version ...)))
(srfi-name? #'(srfi n rest ...))
(let ((srfi-n (make-srfi-n #'srfi #'n)))
(resolve-r6rs-interface
(syntax-case #'(rest ...) ()
(()
#`(library (srfi #,srfi-n (version ...))))
((name rest ...)
;; SRFI 97 says that the first identifier after the `n'
;; is used for the libraries name, so it must be ignored.
#`(library (srfi #,srfi-n rest ... (version ...))))))))
...
--8<---------------cut here---------------end--------------->8---
Notice the comment mentioning that the first identifier following 'n' is
ignored. That seems wrong, at least in the context of R7RS libraries.
--
Thanks,
Maxim
bug-guile <at> gnu.org:bug#67412; Package guile.
(Fri, 24 Nov 2023 16:41:02 GMT) Full text and rfc822 format available.Message #11 received at 67412 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 67412 <at> debbugs.gnu.org Cc: Timothy Sample <samplet <at> ngyro.com>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 1/2] Use R7RS 'rename' syntax for exports. Date: Fri, 24 Nov 2023 11:39:29 -0500
From: Timothy Sample <samplet <at> ngyro.com>
* module/ice-9/r7rs-libraries.scm (define-library): Convert R7RS
exports to R6RS exports before passing them on to 'library'.
Fixes: https://bugs.gnu.org/67255
Reported-by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>.
---
module/ice-9/r7rs-libraries.scm | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)
diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
index 63a300a26..f8b6b4c59 100644
--- a/module/ice-9/r7rs-libraries.scm
+++ b/module/ice-9/r7rs-libraries.scm
@@ -1,5 +1,5 @@
;; R7RS library support
-;; Copyright (C) 2020, 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2020, 2021, 2023 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -97,12 +97,17 @@
((decl ...)
(partition-decls #'(decl ... . decls) exports imports code))))))
+ (define (r7rs-export->r6rs-export export)
+ (syntax-case export (rename)
+ ((rename internal external) #'(rename (internal external)))
+ (_ export)))
+
(syntax-case stx ()
((_ name decl ...)
(call-with-values (lambda ()
(partition-decls #'(decl ...) '() '() '()))
(lambda (exports imports code)
#`(library name
- (export . #,exports)
+ (export . #,(map r7rs-export->r6rs-export exports))
(import . #,imports)
. #,code)))))))
base-commit: d579848cb5d65440af5afd9c8968628665554c22
--
2.41.0
bug-guile <at> gnu.org:bug#67412; Package guile.
(Fri, 24 Nov 2023 16:41:02 GMT) Full text and rfc822 format available.Message #14 received at 67412 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 67412 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH 2/2] r7rs-libraries: Better support R7RS SRFI library names. Date: Fri, 24 Nov 2023 11:39:30 -0500
* module/ice-9/r6rs-libraries.scm (resolve-r6rs-interface)
(library): Move R7RS specifics to...
* module/ice-9/r7rs-libraries.scm (define-library): ... here.
<r7rs-name->r6rs-name, r7rs-import->r6rs-import>: New nested procedures,
used to translate the library name and import sets.
* test-suite/tests/rnrs-libraries.test ("import features"): Add a test.
Fixes: https://bugs.gnu.org/67412
---
module/ice-9/r6rs-libraries.scm | 25 +++--------------
module/ice-9/r7rs-libraries.scm | 48 +++++++++++++++++++++++++++++++--
2 files changed, 50 insertions(+), 23 deletions(-)
diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index f27b07841..78b3dfcfb 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -27,11 +27,6 @@
(define (sym? stx)
(symbol? (syntax->datum stx)))
- (define (n? stx)
- (let ((n (syntax->datum stx)))
- (and (exact-integer? n)
- (not (negative? n)))))
-
(define (colon-n? x)
(let ((sym (syntax->datum x)))
(and (symbol? sym)
@@ -45,8 +40,7 @@
(syntax-case stx (srfi)
((srfi n rest ...)
(and (and-map sym? #'(rest ...))
- (or (n? #'n)
- (colon-n? #'n))))
+ (colon-n? #'n)))
(_ #f)))
(define (module-name? stx)
@@ -63,9 +57,7 @@
(string-append
"srfi-"
(let ((n (syntax->datum n)))
- (if (symbol? n)
- (substring (symbol->string n) 1)
- (number->string n)))))))
+ (substring (symbol->string n) 1))))))
(define (make-custom-interface mod)
(let ((iface (make-module)))
@@ -86,7 +78,6 @@
(syntax-case import-spec (library only except prefix rename srfi)
;; (srfi :n ...) -> (srfi srfi-n ...)
- ;; (srfi n ...) -> (srfi srfi-n ...)
((library (srfi n rest ... (version ...)))
(srfi-name? #'(srfi n rest ...))
(let ((srfi-n (make-srfi-n #'srfi #'n)))
@@ -196,11 +187,6 @@
(define (sym? stx)
(symbol? (syntax->datum stx)))
- (define (n? stx)
- (let ((n (syntax->datum stx)))
- (and (exact-integer? n)
- (not (negative? n)))))
-
(define (colon-n? x)
(let ((sym (syntax->datum x)))
(and (symbol? sym)
@@ -214,8 +200,7 @@
(syntax-case stx (srfi)
((srfi n rest ...)
(and (and-map sym? #'(rest ...))
- (or (n? #'n)
- (colon-n? #'n))))
+ (colon-n? #'n)))
(_ #f)))
(define (module-name? stx)
@@ -232,9 +217,7 @@
(string-append
"srfi-"
(let ((n (syntax->datum n)))
- (if (symbol? n)
- (substring (symbol->string n) 1)
- (number->string n)))))))
+ (substring (symbol->string n) 1))))))
(define (compute-exports ifaces specs)
(define (re-export? sym)
diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
index f8b6b4c59..f2692b833 100644
--- a/module/ice-9/r7rs-libraries.scm
+++ b/module/ice-9/r7rs-libraries.scm
@@ -102,12 +102,56 @@
((rename internal external) #'(rename (internal external)))
(_ export)))
+ (define (r7rs-name->r6rs-name name)
+ ;; This is a hack to support (srfi N x ...) modules in R7RS. The
+ ;; longer term solution would be to add support at the level of
+ ;; resolve-interface (bug #40371).
+ (define (n? stx)
+ (let ((n (syntax->datum stx)))
+ (and (exact-integer? n)
+ (not (negative? n)))))
+
+ (define (srfi-name? stx)
+ (syntax-case stx (srfi)
+ ((srfi n rest ...)
+ (n? #'n))
+ (_ #f)))
+
+ (define (make-srfi-n context n)
+ (datum->syntax
+ context
+ (string->symbol
+ (string-append
+ "srfi-"
+ (let ((n (syntax->datum n)))
+ (number->string n))))))
+
+ (syntax-case name (srfi)
+ ;; (srfi n ...) -> (srfi srfi-n ...)
+ ((srfi n rest ...) (srfi-name? #'(srfi n rest ...))
+ #`(srfi #,(make-srfi-n #'srfi #'n) rest ...))
+ (_ name)))
+
+ (define (r7rs-import->r6rs-import import-set)
+ ;; Normalize SRFI names.
+ (syntax-case import-set (only except prefix rename)
+ ((only import-set identifier ...)
+ #`(only #,(r7rs-import->r6rs-import #'import-set) identifier ...))
+ ((except import-set identifier ...)
+ #`(except #,(r7rs-import->r6rs-import #'import-set) identifier ...))
+ ((prefix import-set identifier ...)
+ #`(prefix #,(r7rs-import->r6rs-import #'import-set) identifier ...))
+ ((rename import-set (from-identifier to-identifier) ...)
+ #`(rename #,(r7rs-import->r6rs-import #'import-set)
+ (from-identifier to-identifier) ...))
+ (_ (r7rs-name->r6rs-name import-set))))
+
(syntax-case stx ()
((_ name decl ...)
(call-with-values (lambda ()
(partition-decls #'(decl ...) '() '() '()))
(lambda (exports imports code)
- #`(library name
+ #`(library #,(r7rs-name->r6rs-name #'name)
(export . #,(map r7rs-export->r6rs-export exports))
- (import . #,imports)
+ (import . #,(map r7rs-import->r6rs-import imports))
. #,code)))))))
--
2.41.0
bug-guile <at> gnu.org:bug#67412; Package guile.
(Fri, 24 Nov 2023 21:21:02 GMT) Full text and rfc822 format available.Message #17 received at 67412 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 67412 <at> debbugs.gnu.org Cc: Timothy Sample <samplet <at> ngyro.com>, Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH v2 1/2] Use R7RS 'rename' syntax for exports. Date: Fri, 24 Nov 2023 16:19:05 -0500
From: Timothy Sample <samplet <at> ngyro.com>
* module/ice-9/r7rs-libraries.scm (define-library): Convert R7RS
exports to R6RS exports before passing them on to 'library'.
Fixes: https://bugs.gnu.org/67255
Reported-by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>.
Modified-by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
---
(no changes since v1)
module/ice-9/r7rs-libraries.scm | 10 ++++++++--
1 file changed, 8 insertions(+), 2 deletions(-)
diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
index 63a300a26..429d82ad9 100644
--- a/module/ice-9/r7rs-libraries.scm
+++ b/module/ice-9/r7rs-libraries.scm
@@ -1,5 +1,5 @@
;; R7RS library support
-;; Copyright (C) 2020, 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2020, 2021, 2023 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -97,12 +97,18 @@
((decl ...)
(partition-decls #'(decl ... . decls) exports imports code))))))
+ (define (r7rs-export->r6rs-export export-spec)
+ (syntax-case export-spec (rename)
+ ((rename from-identifier to-identifier)
+ #'(rename (from-identifier to-identifier)))
+ (identifier #'identifier)))
+
(syntax-case stx ()
((_ name decl ...)
(call-with-values (lambda ()
(partition-decls #'(decl ...) '() '() '()))
(lambda (exports imports code)
#`(library name
- (export . #,exports)
+ (export . #,(map r7rs-export->r6rs-export exports))
(import . #,imports)
. #,code)))))))
base-commit: d579848cb5d65440af5afd9c8968628665554c22
--
2.41.0
bug-guile <at> gnu.org:bug#67412; Package guile.
(Fri, 24 Nov 2023 21:21:02 GMT) Full text and rfc822 format available.Message #20 received at 67412 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 67412 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH v2 2/2] r7rs-libraries: Better support R7RS SRFI library names. Date: Fri, 24 Nov 2023 16:19:06 -0500
* module/ice-9/r6rs-libraries.scm
(resolve-r6rs-interface <srfi-name?>: Relax symbol requirements.
Return a symbol.
<import-spec>: Add a new syntax matching clause to avoid stripping the
3rd identifier in a R7RS SRFI module name.
(library): Move R7RS specifics to...
* module/ice-9/r7rs-libraries.scm (define-library): ... here.
<r7rs-name->r6rs-name, r7rs-import->r6rs-import>: New nested procedures,
used to translate the library name and import sets.
* test-suite/tests/rnrs-libraries.test ("import features")
<"renaming works">: Extend test.
<"import works">: New test.
Fixes: https://bugs.gnu.org/67412
---
Changes in v2:
- Leave/improve some R7RS SRFI handling in r6rs-libraries, for 'import'
- New 'import' test
module/ice-9/r6rs-libraries.scm | 86 ++++++++--------------------
module/ice-9/r7rs-libraries.scm | 48 +++++++++++++++-
test-suite/tests/rnrs-libraries.test | 12 +++-
3 files changed, 81 insertions(+), 65 deletions(-)
diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index f27b07841..f02b13516 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -44,9 +44,9 @@
(define (srfi-name? stx)
(syntax-case stx (srfi)
((srfi n rest ...)
- (and (and-map sym? #'(rest ...))
- (or (n? #'n)
- (colon-n? #'n))))
+ (cond ((n? #'n) 'r7rs)
+ ((colon-n? #'n) 'r6rs)
+ (else #f)))
(_ #f)))
(define (module-name? stx)
@@ -85,10 +85,19 @@
(module-and-uses mod)))
(syntax-case import-spec (library only except prefix rename srfi)
- ;; (srfi :n ...) -> (srfi srfi-n ...)
+ ;; XXX: This is R7RS-specific, but it's here since we want the
+ ;; `import' procedure below to accept (srfi 64) as well as
+ ;; (srfi :64).
+ ;;
;; (srfi n ...) -> (srfi srfi-n ...)
((library (srfi n rest ... (version ...)))
- (srfi-name? #'(srfi n rest ...))
+ (eq? 'r7rs (srfi-name? #'(srfi n rest ...)))
+ (let ((srfi-n (make-srfi-n #'srfi #'n)))
+ (resolve-r6rs-interface
+ #`(library (srfi #,srfi-n rest ... (version ...))))))
+ ;; (srfi :n ...) -> (srfi srfi-n ...)
+ ((library (srfi n rest ... (version ...)))
+ (eq? 'r6rs (srfi-name? #'(srfi n rest ...)))
(let ((srfi-n (make-srfi-n #'srfi #'n)))
(resolve-r6rs-interface
(syntax-case #'(rest ...) ()
@@ -98,7 +107,7 @@
;; SRFI 97 says that the first identifier after the `n'
;; is used for the libraries name, so it must be ignored.
#`(library (srfi #,srfi-n rest ... (version ...))))))))
-
+
((library (name name* ... (version ...)))
(and-map sym? #'(name name* ...))
(resolve-interface (syntax->datum #'(name name* ...))
@@ -107,7 +116,7 @@
((library (name name* ...))
(and-map sym? #'(name name* ...))
(resolve-r6rs-interface #'(library (name name* ... ()))))
-
+
((only import-set identifier ...)
(and-map sym? #'(identifier ...))
(let* ((mod (resolve-r6rs-interface #'import-set))
@@ -121,7 +130,7 @@
(hashq-set! (module-replacements iface) sym #t)))
(syntax->datum #'(identifier ...)))
iface))
-
+
((except import-set identifier ...)
(and-map sym? #'(identifier ...))
(let* ((mod (resolve-r6rs-interface #'import-set))
@@ -182,7 +191,7 @@
(module-remove! iface from)
(hashq-remove! replacements from)
(lp (cdr in) (cons (vector to replace? var) out))))))))
-
+
((name name* ... (version ...))
(module-name? #'(name name* ...))
(resolve-r6rs-interface #'(library (name name* ... (version ...)))))
@@ -196,45 +205,11 @@
(define (sym? stx)
(symbol? (syntax->datum stx)))
- (define (n? stx)
- (let ((n (syntax->datum stx)))
- (and (exact-integer? n)
- (not (negative? n)))))
-
- (define (colon-n? x)
- (let ((sym (syntax->datum x)))
- (and (symbol? sym)
- (let ((str (symbol->string sym)))
- (and (string-prefix? ":" str)
- (let ((num (string->number (substring str 1))))
- (and (exact-integer? num)
- (not (negative? num)))))))))
-
- (define (srfi-name? stx)
- (syntax-case stx (srfi)
- ((srfi n rest ...)
- (and (and-map sym? #'(rest ...))
- (or (n? #'n)
- (colon-n? #'n))))
- (_ #f)))
-
(define (module-name? stx)
- (or (srfi-name? stx)
- (syntax-case stx ()
- ((name name* ...)
- (and-map sym? #'(name name* ...)))
- (_ #f))))
-
- (define (make-srfi-n context n)
- (datum->syntax
- context
- (string->symbol
- (string-append
- "srfi-"
- (let ((n (syntax->datum n)))
- (if (symbol? n)
- (substring (symbol->string n) 1)
- (number->string n)))))))
+ (syntax-case stx ()
+ ((name name* ...)
+ (and-map sym? #'(name name* ...)))
+ (_ #f)))
(define (compute-exports ifaces specs)
(define (re-export? sym)
@@ -282,17 +257,6 @@
(import ispec ...)
body ...))
- ((_ (srfi n rest ... (version ...))
- (export espec ...)
- (import ispec ...)
- body ...)
- (srfi-name? #'(srfi n rest ...))
- (let ((srfi-n (make-srfi-n #'srfi #'n)))
- #`(library (srfi #,srfi-n rest ... (version ...))
- (export espec ...)
- (import ispec ...)
- body ...)))
-
((_ (name name* ... (version ...))
(export espec ...)
(import ispec ...)
@@ -328,7 +292,7 @@
(export! x ...)
(@@ @@ (name name* ...) body)
...))))))))
-
+
(define-syntax import
(lambda (stx)
(define (strip-for import-set)
@@ -343,7 +307,7 @@
#'(eval-when (expand load eval)
(let ((iface (resolve-r6rs-interface 'library-reference)))
(call-with-deferred-observers
- (lambda ()
- (module-use-interfaces! (current-module) (list iface)))))
+ (lambda ()
+ (module-use-interfaces! (current-module) (list iface)))))
...
(if #f #f)))))))
diff --git a/module/ice-9/r7rs-libraries.scm b/module/ice-9/r7rs-libraries.scm
index 429d82ad9..c6f70d73f 100644
--- a/module/ice-9/r7rs-libraries.scm
+++ b/module/ice-9/r7rs-libraries.scm
@@ -103,12 +103,56 @@
#'(rename (from-identifier to-identifier)))
(identifier #'identifier)))
+ (define (r7rs-name->r6rs-name name)
+ ;; This is a hack to support (srfi N x ...) modules in R7RS. The
+ ;; longer term solution would be to add support at the level of
+ ;; resolve-interface (bug #40371).
+ (define (n? stx)
+ (let ((n (syntax->datum stx)))
+ (and (exact-integer? n)
+ (not (negative? n)))))
+
+ (define (srfi-name? stx)
+ (syntax-case stx (srfi)
+ ((srfi n rest ...)
+ (n? #'n))
+ (_ #f)))
+
+ (define (make-srfi-n context n)
+ (datum->syntax
+ context
+ (string->symbol
+ (string-append
+ "srfi-"
+ (let ((n (syntax->datum n)))
+ (number->string n))))))
+
+ (syntax-case name (srfi)
+ ;; (srfi n ...) -> (srfi srfi-n ...)
+ ((srfi n rest ...) (srfi-name? #'(srfi n rest ...))
+ #`(srfi #,(make-srfi-n #'srfi #'n) rest ...))
+ (_ name)))
+
+ (define (r7rs-import->r6rs-import import-set)
+ ;; Normalize SRFI names.
+ (syntax-case import-set (only except prefix rename)
+ ((only import-set identifier ...)
+ #`(only #,(r7rs-import->r6rs-import #'import-set) identifier ...))
+ ((except import-set identifier ...)
+ #`(except #,(r7rs-import->r6rs-import #'import-set) identifier ...))
+ ((prefix import-set identifier ...)
+ #`(prefix #,(r7rs-import->r6rs-import #'import-set) identifier ...))
+ ((rename import-set (from-identifier to-identifier) ...)
+ #`(rename #,(r7rs-import->r6rs-import #'import-set)
+ (from-identifier to-identifier) ...))
+ (_ (r7rs-name->r6rs-name import-set))))
+
(syntax-case stx ()
((_ name decl ...)
(call-with-values (lambda ()
(partition-decls #'(decl ...) '() '() '()))
(lambda (exports imports code)
- #`(library name
+ #`(library #,(r7rs-name->r6rs-name #'name)
(export . #,(map r7rs-export->r6rs-export exports))
- (import . #,imports)
+ (import . #,(map r7rs-import->r6rs-import imports))
. #,code)))))))
diff --git a/test-suite/tests/rnrs-libraries.test b/test-suite/tests/rnrs-libraries.test
index 86035e508..0fa7acb5c 100644
--- a/test-suite/tests/rnrs-libraries.test
+++ b/test-suite/tests/rnrs-libraries.test
@@ -205,9 +205,17 @@
(with-test-prefix "srfi"
(pass-if "renaming works"
(eq? (resolve-interface '(srfi srfi-1))
- (resolve-r6rs-interface '(srfi :1)))
+ (resolve-r6rs-interface '(srfi :1))
+ (resolve-r6rs-interface '(srfi 1)))
(eq? (resolve-interface '(srfi srfi-1))
- (resolve-r6rs-interface '(srfi :1 lists)))))
+ (resolve-r6rs-interface '(srfi :1 lists))
+ (resolve-r6rs-interface '(srfi 1))))
+
+ (pass-if "import works"
+ (import (srfi srfi-1))
+ (import (srfi :1))
+ (import (srfi 1))
+ #t))
(with-test-prefix "macro"
(pass-if "multiple clauses"
--
2.41.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.