* srfi-13.scm: Mark replacements.

* srfi-17.scm: Mark replacements.

* boot-9.scm (module-make-local-var!): Use module-add!.
(module-primitive-add!): New function.
(resolve-interface): Use
(call-with-deferred-observers, module-call-observers): New
functions.
(module-defer-observers, module-defer-observers-mute,
module-defer-observers-table): New variables.
(process-define-module, process-use-modules, export, re-export):
Use call-with-deferred-observers.

* syncase.scm (eval): Mark as replacement.

* boot-9.scm (defmacro-public): Use export-syntax instead of export.

ice-9/ChangeLog

@@ -1,5 +1,19 @@
 2003-03-12  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
+	* boot-9.scm (module-make-local-var!): Use module-add!.
+	(module-primitive-add!): New function.
+	(resolve-interface): Use
+	(call-with-deferred-observers, module-call-observers): New
+	functions.
+	(module-defer-observers, module-defer-observers-mute,
+	module-defer-observers-table): New variables.
+	(process-define-module, process-use-modules, export, re-export):
+	Use call-with-deferred-observers.
+
+	* syncase.scm (eval): Mark as replacement.
+
+	* boot-9.scm (defmacro-public): Use export-syntax instead of export.
+
 	* slib.scm (*features*): Set the core variable instead of defining
 	a local version.
 	(provide, provided?): Mark as replacements.

ice-9/boot-9.scm

@@ -1072,7 +1072,33 @@
 	(set-module-observers! module (delq1! id (module-observers module)))))
   *unspecified*)
 
+(define module-defer-observers #f)
+(define module-defer-observers-mutex (make-mutex))
+(define module-defer-observers-table (make-hash-table))
+
 (define (module-modified m)
+  (if module-defer-observers
+      (hash-set! module-defer-observers-table m #t)
+      (module-call-observers m)))
+
+;;; This function can be used to delay calls to observers so that they
+;;; can be called once only in the face of massive updating of modules.
+;;;
+(define (call-with-deferred-observers thunk)
+  (dynamic-wind
+      (lambda ()
+	(lock-mutex module-defer-observers-mutex)
+	(set! module-defer-observers #t))
+      thunk
+      (lambda ()
+	(set! module-defer-observers #f)
+	(hash-for-each (lambda (m dummy)
+			 (module-call-observers m))
+		       module-defer-observers-table)
+	(hash-clear! module-defer-observers-table)
+	(unlock-mutex module-defer-observers-mutex))))
+
+(define (module-call-observers m)
   (for-each (lambda (proc) (proc m)) (module-observers m))
   (hash-fold (lambda (id proc res) (proc m)) #f (module-weak-observers m)))
 
@@ -1267,18 +1293,21 @@
 ;; If no variable was already there, then create a new and uninitialzied
 ;; variable.
 ;;
+;; This function is used in modules.c.
+;;
 (define (module-make-local-var! m v)
   (or (let ((b (module-obarray-ref (module-obarray m) v)))
 	(and (variable? b)
 	     (begin
+	       ;; Mark as modified since this function is called when
+	       ;; the standard eval closure defines a binding
 	       (module-modified m)
 	       b)))
       (and (module-binder m)
 	   ((module-binder m) m v #t))
       (begin
 	(let ((answer (make-undefined-variable)))
-	  (module-obarray-set! (module-obarray m) v answer)
+	  (module-add! m v answer)
-	  (module-modified m)
 	  answer))))
 
 ;; module-ensure-local-variable! module symbol
@@ -1778,11 +1807,12 @@
 	       (re-exports '())
 	       (replacements '()))
       (if (null? kws)
-	  (begin
+	  (call-with-deferred-observers
+	   (lambda ()
 	     (module-use-interfaces! module (reverse reversed-interfaces))
 	     (module-export! module exports)
 	     (module-replace! module replacements)
-	    (module-re-export! module re-exports))
+	     (module-re-export! module re-exports)))
 	  (case (car kws)
 	    ((#:use-module #:use-syntax)
 	     (or (pair? (cdr kws))
@@ -2639,11 +2669,13 @@
 ;; to change scm_c_use_module as well.
 
 (define (process-use-modules module-interface-args)
-  (module-use-interfaces! (current-module)
+  (let ((interfaces (map (lambda (mif-args)
-			  (map (lambda (mif-args)
 			   (or (apply resolve-interface mif-args)
 			       (error "no such module" mif-args)))
 			 module-interface-args)))
+    (call-with-deferred-observers
+     (lambda ()
+       (module-use-interfaces! (current-module) interfaces)))))
 
 (defmacro use-modules modules
   `(eval-case
@@ -2703,7 +2735,7 @@
    (#t
     (let ((name (defined-name (car args))))
       `(begin
-	 (eval-case ((load-toplevel) (export ,name)))
+	 (eval-case ((load-toplevel) (export-syntax ,name)))
 	 (defmacro ,@args))))))
 
 ;; Export a local variable
@@ -2743,14 +2775,18 @@
 (defmacro export names
   `(eval-case
     ((load-toplevel)
-     (module-export! (current-module) ',names))
+     (call-with-deferred-observers
+      (lambda ()
+	(module-export! (current-module) ',names))))
     (else
      (error "export can only be used at the top level"))))
 
 (defmacro re-export names
   `(eval-case
     ((load-toplevel)
-     (module-re-export! (current-module) ',names))
+     (call-with-deferred-observers
+      (lambda ()
+	(module-re-export! (current-module) ',names))))
     (else
      (error "re-export can only be used at the top level"))))
 

ice-9/syncase.scm

@@ -54,7 +54,8 @@
 	   syntax-dispatch syntax-error bound-identifier=?
 	   datum->syntax-object free-identifier=?
 	   generate-temporaries identifier? syntax-object->datum
-	   void eval syncase))
+	   void syncase)
+  :replace (eval))
 
 
 

srfi/ChangeLog

@@ -1,3 +1,9 @@
+2003-03-12  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+	* srfi-13.scm: Mark replacements.
+
+	* srfi-17.scm: Mark replacements.
+
 2003-03-11  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
 	* srfi-1.scm (iota, map, for-each, map-in-order, list-index,

srfi/srfi-13.scm

@@ -1,6 +1,6 @@
 ;;; srfi-13.scm --- String Library
 
-;; 	Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; 	Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -47,9 +47,8 @@
 
 ;;; Code:
 
-(define-module (srfi srfi-13))
+(define-module (srfi srfi-13)
-
+  :export (
-(export
 ;;; Predicates
  ;; string? string-null?       <= in the core
  string-any string-every
@@ -59,14 +58,14 @@
  string-tabulate
 
 ;;; List/string conversion
- string->list
+ ;; string->list	       extended
  ;; list->string               <= in the core
  reverse-list->string
  string-join
 
 ;;; Selection
  ;; string-length string-ref   <= in the core
- string-copy
+ ;; string-copy		       extended
  substring/shared
  string-copy!
  string-take string-take-right
@@ -77,7 +76,7 @@
 
 ;;; Modification
  ;; string-set!                <= in the core
- string-fill!
+ ;; string-fill!		extended
 
 ;;; Comparison
  string-compare string-compare-ci
@@ -100,15 +99,16 @@
  string-suffix-ci?
 
 ;;; Searching
- string-index string-index-right
+ ;; string-index			extended
+ string-index-right
  string-skip string-skip-right
  string-count
  string-contains string-contains-ci
 
 ;;; Alphabetic case mapping
 
- string-upcase string-upcase!
+ ;; string-upcase string-upcase!	extended
- string-downcase string-downcase!
+ ;; string-downcase string-downcase!	extended
  string-titlecase string-titlecase!
 
 ;;; Reverse/Append
@@ -140,6 +140,10 @@
  string-filter
  string-delete
  )
+  :replace (string->list string-copy string-fill!
+	    string-upcase! string-upcase string-downcase! string-downcase
+	    string-index)
+  )
 
 (cond-expand-provide (current-module) '(srfi-13))
 

srfi/srfi-17.scm

@@ -1,6 +1,6 @@
 ;;; srfi-17.scm --- Generalized set!
 
-;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -68,9 +68,9 @@
 ;;; Code:
 
 (define-module (srfi srfi-17)
-  :export (getter-with-setter
+  :export (getter-with-setter)
+  :replace (;; redefined standard procedures
 	    setter
-	   ;; redefined standard procedures
 	    car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar
 	    cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr
 	    caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr