mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-04 16:50:25 +02:00
(%cond-expand-features): add srfi-55.
(require-extension): add require-extension macro for srfi-55.
This commit is contained in:
parent
e2c80f891b
commit
344d68d521
1 changed files with 36 additions and 0 deletions
|
@ -3241,6 +3241,7 @@
|
||||||
srfi-6 ;; open-input-string etc, in the guile core
|
srfi-6 ;; open-input-string etc, in the guile core
|
||||||
srfi-13 ;; string library
|
srfi-13 ;; string library
|
||||||
srfi-14 ;; character sets
|
srfi-14 ;; character sets
|
||||||
|
srfi-55 ;; require-extension
|
||||||
))
|
))
|
||||||
|
|
||||||
;; This table maps module public interfaces to the list of features.
|
;; This table maps module public interfaces to the list of features.
|
||||||
|
@ -3335,6 +3336,41 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;;; srfi-55: require-extension
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define-macro (require-extension extension-spec)
|
||||||
|
;; This macro only handles the srfi extension, which, at present, is
|
||||||
|
;; the only one defined by the standard.
|
||||||
|
(if (not (pair? extension-spec))
|
||||||
|
(scm-error 'wrong-type-arg "require-extension"
|
||||||
|
"Not an extension: ~S" (list extension-spec) #f))
|
||||||
|
(let ((extension (car extension-spec))
|
||||||
|
(extension-args (cdr extension-spec)))
|
||||||
|
(case extension
|
||||||
|
((srfi)
|
||||||
|
(let ((use-list '()))
|
||||||
|
(for-each
|
||||||
|
(lambda (i)
|
||||||
|
(if (not (integer? i))
|
||||||
|
(scm-error 'wrong-type-arg "require-extension"
|
||||||
|
"Invalid srfi name: ~S" (list i) #f))
|
||||||
|
(let ((srfi-sym (string->symbol
|
||||||
|
(string-append "srfi-" (number->string i)))))
|
||||||
|
(if (not (memq srfi-sym %cond-expand-features))
|
||||||
|
(set! use-list (cons `(use-modules (srfi ,srfi-sym))
|
||||||
|
use-list)))))
|
||||||
|
extension-args)
|
||||||
|
(if (pair? use-list)
|
||||||
|
;; i.e. (begin (use-modules x) (use-modules y) (use-modules z))
|
||||||
|
`(begin ,@(reverse! use-list)))))
|
||||||
|
(else
|
||||||
|
(scm-error
|
||||||
|
'wrong-type-arg "require-extension"
|
||||||
|
"Not a recognized extension type: ~S" (list extension) #f)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; {Load emacs interface support if emacs option is given.}
|
;;; {Load emacs interface support if emacs option is given.}
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue