mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

* srfi-13.scm: Mark replacements.

Browse source 
* 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.
This commit is contained in:
Mikael Djurfeldt 2003-03-12 14:11:42 +00:00
parent 70a9dc9cde
commit d57da08b6d
6 changed files with 100 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

14
ice-9/ChangeLog
View file

@ -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.

76
ice-9/boot-9.scm
View file

@ -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"))))

3
ice-9/syncase.scm
View file

@ -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))

6
srfi/ChangeLog
View file

@ -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,

24
srfi/srfi-13.scm
View file

@ -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))

16
srfi/srfi-17.scm
View file

@ -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))