* 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).