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

	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.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 39ad3c8..fda2e46 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -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.

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index cf38dca..884b7f3 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -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))))))
 
 \f