* 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
@@ -1731,10 +1760,10 @@
 	  (set-module-name! custom-i name)
 	  ;; XXX - should use a lazy binder so that changes to the
 	  ;; used module are picked up automatically.
-          (for-each (lambda (bspec)
+	  (for-each (lambda (bspec)
-                      (let* ((direct? (symbol? bspec))
+		      (let* ((direct? (symbol? bspec))
-                             (orig (if direct? bspec (car bspec)))
+			     (orig (if direct? bspec (car bspec)))
-                             (seen (if direct? bspec (cdr bspec)))
+			     (seen (if direct? bspec (cdr bspec)))
 			     (var (or (module-local-variable public-i orig)
 				      (module-local-variable module orig)
 				      (error
@@ -1747,7 +1776,7 @@
 			    (module-add! custom-i
 					 (renamer seen)
 					 var))))
-                    selection)
+		    selection)
 	  ;; Check that we are not hiding bindings which don't exist
 	  (for-each (lambda (binding)
 		      (if (not (module-local-variable public-i binding))
@@ -1778,11 +1807,12 @@
 	       (re-exports '())
 	       (replacements '()))
       (if (null? kws)
-	  (begin
+	  (call-with-deferred-observers
-	    (module-use-interfaces! module (reverse reversed-interfaces))
+	   (lambda ()
-	    (module-export! module exports)
+	     (module-use-interfaces! module (reverse reversed-interfaces))
-	    (module-replace! module replacements)
+	     (module-export! module exports)
-	    (module-re-export! module re-exports))
+	     (module-replace! module replacements)
+	     (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)
-				 (or (apply resolve-interface mif-args)
+			       (error "no such module" mif-args)))
-				     (error "no such module" mif-args)))
+			 module-interface-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,13 +68,13 @@
 ;;; Code:
 
 (define-module (srfi srfi-17)
-  :export (getter-with-setter
+  :export (getter-with-setter)
-	   setter
+  :replace (;; redefined standard procedures
-	   ;; redefined standard procedures
+	    setter
-	   car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar
+	    car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar
-	   cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr
+	    cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr
-	   caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr
+	    caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr
-	   cdddar cddddr string-ref vector-ref))
+	    cdddar cddddr string-ref vector-ref))
 
 (cond-expand-provide (current-module) '(srfi-17))