1
Fork 0
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:
Rob Browning 2005-02-12 06:12:21 +00:00
parent e2c80f891b
commit 344d68d521

View file

@ -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.}
;;; ;;;