bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160)

bug#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160)

[Maxim Cournoyer]

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#67412: (resolve-r6rs-interface '(srfi 160 u8) tries to load (srfi srfi-160)

[Maxim Cournoyer]

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#67412: [PATCH 1/2] Use R7RS 'rename' syntax for exports.

[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

bug#67412: [PATCH 2/2] r7rs-libraries: Better support R7RS SRFI library names.

[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

bug#67412: [PATCH v2 1/2] Use R7RS 'rename' syntax for exports.

[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

bug#67412: [PATCH v2 2/2] r7rs-libraries: Better support R7RS SRFI library names.

[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