diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index ffebfa332..d8f97ad58 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,5 +1,19 @@ 2003-03-12 Mikael Djurfeldt + * 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. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index 666c4caf9..e17c6f22a 100644 --- a/ice-9/boot-9.scm +++ b/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-modified m) + (module-add! m v answer) 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) - (let* ((direct? (symbol? bspec)) - (orig (if direct? bspec (car bspec))) - (seen (if direct? bspec (cdr bspec))) + (for-each (lambda (bspec) + (let* ((direct? (symbol? bspec)) + (orig (if direct? bspec (car 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 - (module-use-interfaces! module (reverse reversed-interfaces)) - (module-export! module exports) - (module-replace! module replacements) - (module-re-export! module re-exports)) + (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))) (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) - (map (lambda (mif-args) - (or (apply resolve-interface mif-args) - (error "no such module" mif-args))) - module-interface-args))) + (let ((interfaces (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")))) diff --git a/ice-9/syncase.scm b/ice-9/syncase.scm index d83d30a4e..94b58d9a1 100644 --- a/ice-9/syncase.scm +++ b/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)) diff --git a/srfi/ChangeLog b/srfi/ChangeLog index ee32af7ba..7921df7a3 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,9 @@ +2003-03-12 Mikael Djurfeldt + + * srfi-13.scm: Mark replacements. + + * srfi-17.scm: Mark replacements. + 2003-03-11 Mikael Djurfeldt * srfi-1.scm (iota, map, for-each, map-in-order, list-index, diff --git a/srfi/srfi-13.scm b/srfi/srfi-13.scm index 1ca8edac3..b5e770548 100644 --- a/srfi/srfi-13.scm +++ b/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)) - -(export +(define-module (srfi srfi-13) + :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-downcase string-downcase! + ;; string-upcase string-upcase! extended + ;; 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)) diff --git a/srfi/srfi-17.scm b/srfi/srfi-17.scm index 4ec71c595..1b15f22a2 100644 --- a/srfi/srfi-17.scm +++ b/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 - 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 - cdddar cddddr string-ref vector-ref)) + :export (getter-with-setter) + :replace (;; redefined standard procedures + setter + 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 + cdddar cddddr string-ref vector-ref)) (cond-expand-provide (current-module) '(srfi-17))