From b9b8f9da6020bbb18a0478d980ed8b291f6ee168 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20Grabm=C3=BCller?= Date: Wed, 23 May 2001 05:08:17 +0000 Subject: [PATCH] * 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. --- ice-9/ChangeLog | 11 +++++++++++ ice-9/boot-9.scm | 26 ++++++++++++++++++++++---- 2 files changed, 33 insertions(+), 4 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 39ad3c82f..fda2e46f7 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,14 @@ +2001-05-23 Martin Grabmueller + + * 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 + + * boot-9.scm (use-srfis): Do not extend the srfi-0 feature list. + (cond-expand-provide): New procedure. + 2001-05-22 Marius Vollmer * boot-9.scm (define-module): Return the new module. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index cf38dcaed..884b7f3c3 100644 --- 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))))))