summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>2003-03-12 14:11:42 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>2003-03-12 14:11:42 +0000
commitd57da08b6de23716b99afcc3a596d1ee1292fb5f (patch)
tree8c53936fca41453c51f28d3725c740246e34b241
parent70a9dc9cdec6b1073459488ea2af2a99e328c94c (diff)
downloadguile-d57da08b6de23716b99afcc3a596d1ee1292fb5f.tar.gz
* 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.
-rw-r--r--ice-9/ChangeLog14
-rw-r--r--ice-9/boot-9.scm76
-rw-r--r--ice-9/syncase.scm3
-rw-r--r--srfi/ChangeLog6
-rw-r--r--srfi/srfi-13.scm24
-rw-r--r--srfi/srfi-17.scm16
6 files changed, 100 insertions, 39 deletions
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 <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.
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 <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,
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))