* bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160)
@ 2023-11-23 19:45 Maxim Cournoyer
2023-11-23 21:44 ` Maxim Cournoyer
` (2 more replies)
0 siblings, 3 replies; 6+ messages in thread
From: Maxim Cournoyer @ 2023-11-23 19:45 UTC (permalink / raw)
To: 67412
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
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160)
2023-11-23 19:45 bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160) Maxim Cournoyer
@ 2023-11-23 21:44 ` Maxim Cournoyer
2023-11-24 16:39 ` bug#67412: [PATCH 1/2] Use R7RS 'rename' syntax for exports Maxim Cournoyer
2023-11-24 21:19 ` bug#67412: [PATCH v2 1/2] Use R7RS 'rename' syntax for exports Maxim Cournoyer
2 siblings, 0 replies; 6+ messages in thread
From: Maxim Cournoyer @ 2023-11-23 21:44 UTC (permalink / raw)
To: 67412
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
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#67412: [PATCH 1/2] Use R7RS 'rename' syntax for exports.
2023-11-23 19:45 bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160) Maxim Cournoyer
2023-11-23 21:44 ` Maxim Cournoyer
@ 2023-11-24 16:39 ` Maxim Cournoyer
2023-11-24 16:39 ` bug#67412: [PATCH 2/2] r7rs-libraries: Better support R7RS SRFI library names Maxim Cournoyer
2023-11-24 21:19 ` bug#67412: [PATCH v2 1/2] Use R7RS 'rename' syntax for exports Maxim Cournoyer
2 siblings, 1 reply; 6+ messages in thread
From: Maxim Cournoyer @ 2023-11-24 16:39 UTC (permalink / raw)
To: 67412; +Cc: Timothy Sample, Maxim Cournoyer
From: Timothy Sample <samplet@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@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
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#67412: [PATCH 2/2] r7rs-libraries: Better support R7RS SRFI library names.
2023-11-24 16:39 ` bug#67412: [PATCH 1/2] Use R7RS 'rename' syntax for exports Maxim Cournoyer
@ 2023-11-24 16:39 ` Maxim Cournoyer
0 siblings, 0 replies; 6+ messages in thread
From: Maxim Cournoyer @ 2023-11-24 16:39 UTC (permalink / raw)
To: 67412; +Cc: Maxim Cournoyer
* 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
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#67412: [PATCH v2 1/2] Use R7RS 'rename' syntax for exports.
2023-11-23 19:45 bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160) Maxim Cournoyer
2023-11-23 21:44 ` Maxim Cournoyer
2023-11-24 16:39 ` bug#67412: [PATCH 1/2] Use R7RS 'rename' syntax for exports Maxim Cournoyer
@ 2023-11-24 21:19 ` Maxim Cournoyer
2023-11-24 21:19 ` bug#67412: [PATCH v2 2/2] r7rs-libraries: Better support R7RS SRFI library names Maxim Cournoyer
2 siblings, 1 reply; 6+ messages in thread
From: Maxim Cournoyer @ 2023-11-24 21:19 UTC (permalink / raw)
To: 67412; +Cc: Timothy Sample, Maxim Cournoyer
From: Timothy Sample <samplet@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@gmail.com>.
Modified-by: Maxim Cournoyer <maxim.cournoyer@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
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#67412: [PATCH v2 2/2] r7rs-libraries: Better support R7RS SRFI library names.
2023-11-24 21:19 ` bug#67412: [PATCH v2 1/2] Use R7RS 'rename' syntax for exports Maxim Cournoyer
@ 2023-11-24 21:19 ` Maxim Cournoyer
0 siblings, 0 replies; 6+ messages in thread
From: Maxim Cournoyer @ 2023-11-24 21:19 UTC (permalink / raw)
To: 67412; +Cc: Maxim Cournoyer
* 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
^ permalink raw reply related [flat|nested] 6+ messages in thread
end of thread, other threads:[~2023-11-24 21:19 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-11-23 19:45 bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160) Maxim Cournoyer
2023-11-23 21:44 ` Maxim Cournoyer
2023-11-24 16:39 ` bug#67412: [PATCH 1/2] Use R7RS 'rename' syntax for exports Maxim Cournoyer
2023-11-24 16:39 ` bug#67412: [PATCH 2/2] r7rs-libraries: Better support R7RS SRFI library names Maxim Cournoyer
2023-11-24 21:19 ` bug#67412: [PATCH v2 1/2] Use R7RS 'rename' syntax for exports Maxim Cournoyer
2023-11-24 21:19 ` bug#67412: [PATCH v2 2/2] r7rs-libraries: Better support R7RS SRFI library names Maxim Cournoyer
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).