mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Improve support for R6/R7 SRFI module name formats.

Browse source 
Fixes <https://bugs.gnu.org/39601>.

Partly fixes <https://bugs.gnu.org/40371>.

It was already possible to import an SRFI module by referencing it
as (srfi :n) which is automatically translated to (srfi srfi-n), but
this conversion was only done during import.  After this change, it's
also possible to define a library as (srfi :n) which is automatically
translated to (srfi srfi-n) during definition.

It was not possible at all to define or import SRFI module names in the
R7RS format, (srfi n), where n is a non-negative exact integer.  It is
now possible both to define and import them as such, realized through
the same kind of conversion to a canonical (srfi srfi-n) name.

* module/ice-9/r6rs-libraries.scm: Numerous changes.
This commit is contained in:
Taylan Kammer 2021-05-10 18:12:34 +02:00 • committed by Daniel Llorens
parent 708df04f3b
commit a960d7869b
1 changed files with 108 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

130
module/ice-9/r6rs-libraries.scm
View file

@ -20,7 +20,53 @@
;; This file is included from boot-9.scm and assumes the existence of (and
;; expands into) procedures and syntactic forms defined therein.
;; Note that we can't use top-level define for helpers here as it will
;; pollute the (guile) module.
(define (resolve-r6rs-interface import-spec)
(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)))))))
(define (make-custom-interface mod)
(let ((iface (make-module)))
(set-module-kind! iface 'custom-interface)
@ -37,27 +83,13 @@
(for-each (lambda (mod)
(module-for-each f mod))
(module-and-uses mod)))
(define (sym? x) (symbol? (syntax->datum x)))
(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 ...)))
(and (and-map sym? #'(srfi rest ...))
(or (and
(symbol? (syntax->datum #'n))
(let ((str (symbol->string (syntax->datum #'n))))
(and (string-prefix? ":" str)
(and=> (string->number (substring str 1))
exact-integer?))))
(exact-integer? (syntax->datum #'n))))
(let ((srfi-n (string->symbol
(string-append
"srfi-"
(let ((n (syntax->datum #'n)))
(if (symbol? n)
(substring (symbol->string n) 1)
(number->string n)))))))
(srfi-name? #'(srfi n rest ...))
(let ((srfi-n (make-srfi-n #'srfi #'n)))
(resolve-r6rs-interface
(syntax-case #'(rest ...) ()
(()
@ -152,15 +184,58 @@
(lp (cdr in) (cons (vector to replace? var) out))))))))
((name name* ... (version ...))
(and-map sym? #'(name name* ...))
(module-name? #'(name name* ...))
(resolve-r6rs-interface #'(library (name name* ... (version ...)))))
((name name* ...)
(and-map sym? #'(name name* ...))
((name name* ...)
(module-name? #'(name name* ...))
(resolve-r6rs-interface #'(library (name name* ... ()))))))
(define-syntax library
(lambda (stx)
(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)))))))
(define (compute-exports ifaces specs)
(define (re-export? sym)
(or-map (lambda (iface) (module-variable iface sym)) ifaces))
@ -195,23 +270,34 @@
(else
(lp #'rest (cons #'id e) r x))))))))
(syntax-case stx (export import)
(syntax-case stx (export import srfi)
((_ (name name* ...)
(export espec ...)
(import ispec ...)
body ...)
(and-map identifier? #'(name name* ...))
(module-name? #'(name name* ...))
;; Add () as the version.
#'(library (name name* ... ())
(export espec ...)
(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 ...)
body ...)
(and-map identifier? #'(name name* ...))
(module-name? #'(name name* ...))
(call-with-values
(lambda ()
(compute-exports