mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

Extend `import' to allow R7RS-style srfi references

Browse source 
* module/ice-9/r6rs-libraries.scm (resolve-r6rs-interface): Allow for
  srfis to be accessed via (srfi 42 foo) in addition to (srfi :42 foo).
This commit is contained in:
Andy Wingo 2019-09-27 22:36:24 +02:00
parent 3e02bf7259
commit 2cca09126e
1 changed files with 15 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,6 +1,6 @@
;;; r6rs-libraries.scm --- Support for the R6RS `library' and `import' forms ;;; r6rs-libraries.scm --- Support for the R6RS `library' and `import' forms
;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Copyright (C) 2010, 2019 Free Software Foundation, Inc.
;; ;;
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -41,21 +41,29 @@
(syntax-case import-spec (library only except prefix rename srfi) (syntax-case import-spec (library only except prefix rename srfi)
;; (srfi :n ...) -> (srfi srfi-n ...) ;; (srfi :n ...) -> (srfi srfi-n ...)
((library (srfi colon-n rest ... (version ...))) ;; (srfi n ...) -> (srfi srfi-n ...)
((library (srfi n rest ... (version ...)))
(and (and-map sym? #'(srfi rest ...)) (and (and-map sym? #'(srfi rest ...))
(symbol? (syntax->datum #'colon-n)) (or (and
(eqv? (string-ref (symbol->string (syntax->datum #'colon-n)) 0) #\:)) (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 (let ((srfi-n (string->symbol
(string-append (string-append
"srfi-" "srfi-"
(substring (symbol->string (syntax->datum #'colon-n)) (let ((n (syntax->datum #'n)))
1))))) (if (symbol? n)
(substring (symbol->string n) 1)
(number->string n)))))))
(resolve-r6rs-interface (resolve-r6rs-interface
(syntax-case #'(rest ...) () (syntax-case #'(rest ...) ()
(() (()
#`(library (srfi #,srfi-n (version ...)))) #`(library (srfi #,srfi-n (version ...))))
((name rest ...) ((name rest ...)
;; SRFI 97 says that the first identifier after the colon-n ;; SRFI 97 says that the first identifier after the `n'
;; is used for the libraries name, so it must be ignored. ;; is used for the libraries name, so it must be ignored.
#`(library (srfi #,srfi-n rest ... (version ...)))))))) #`(library (srfi #,srfi-n rest ... (version ...))))))))