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

* boot-9.scm (%cond-expand-table): New hash table mapping modules

Browse source 
to feature lists.
	(cond-expand): Use feature information associated with modules.

	* boot-9.scm (use-srfis): Do not extend the srfi-0 feature list.
	(cond-expand-provide): New procedure.
This commit is contained in:
Martin Grabmüller 2001-05-23 05:08:17 +00:00
parent 1b2f40b9f1
commit b9b8f9da60
2 changed files with 33 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

11
ice-9/ChangeLog
View file

@ -1,3 +1,14 @@
2001-05-23 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
* boot-9.scm (%cond-expand-table): New hash table mapping modules
to feature lists.
(cond-expand): Use feature information associated with modules.
2001-05-21 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
* boot-9.scm (use-srfis): Do not extend the srfi-0 feature list.
(cond-expand-provide): New procedure.
2001-05-22 Marius Vollmer <mvo@zagadka.ping.de>
* boot-9.scm (define-module): Return the new module.

26
ice-9/boot-9.scm
View file

@ -2723,10 +2723,24 @@
;;;
;;; Remember to update the features list when adding more SRFIs.
(define cond-expand-features
(define %cond-expand-features
;; Adjust the above comment when changing this.
'(guile r5rs srfi-0))
;; This table maps module public interfaces to the list of features.
;;
(define %cond-expand-table (make-hash-table 31))
;; Add one or more features to the `cond-expand' feature list of the
;; module `module'.
;;
(define (cond-expand-provide module features)
(let ((mod (module-public-interface module)))
(and mod
(hashq-set! %cond-expand-table mod
(append (hashq-ref %cond-expand-table mod '())
features)))))
(define-macro (cond-expand clause . clauses)
(let ((clauses (cons clause clauses))
@ -2737,7 +2751,13 @@
(lambda (clause)
(cond
((symbol? clause)
(memq clause cond-expand-features))
(or (memq clause %cond-expand-features)
(let lp ((uses (module-uses (current-module))))
(if (pair? uses)
(or (memq clause
(hashq-ref %cond-expand-table (car uses) '()))
(lp (cdr uses)))
#f))))
((pair? clause)
(cond
((eq? 'and (car clause))
@ -2793,8 +2813,6 @@
(string-append "srfi-" (number->string (car s)))))
(mod-i (resolve-interface (list 'srfi srfi))))
(module-use! (current-module) mod-i)
(set! cond-expand-features
(append cond-expand-features (list srfi)))
(lp (cdr s))))))