/[guile]/guile/guile-core/ice-9/boot-9.scm
ViewVC logotype

Diff of /guile/guile-core/ice-9/boot-9.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.305 by mdj, Wed Mar 12 10:03:25 2003 UTC revision 1.306 by mdj, Wed Mar 12 14:11:36 2003 UTC
# Line 1072  Line 1072 
1072          (set-module-observers! module (delq1! id (module-observers module)))))          (set-module-observers! module (delq1! id (module-observers module)))))
1073    *unspecified*)    *unspecified*)
1074    
1075    (define module-defer-observers #f)
1076    (define module-defer-observers-mutex (make-mutex))
1077    (define module-defer-observers-table (make-hash-table))
1078    
1079  (define (module-modified m)  (define (module-modified m)
1080      (if module-defer-observers
1081          (hash-set! module-defer-observers-table m #t)
1082          (module-call-observers m)))
1083    
1084    ;;; This function can be used to delay calls to observers so that they
1085    ;;; can be called once only in the face of massive updating of modules.
1086    ;;;
1087    (define (call-with-deferred-observers thunk)
1088      (dynamic-wind
1089          (lambda ()
1090            (lock-mutex module-defer-observers-mutex)
1091            (set! module-defer-observers #t))
1092          thunk
1093          (lambda ()
1094            (set! module-defer-observers #f)
1095            (hash-for-each (lambda (m dummy)
1096                             (module-call-observers m))
1097                           module-defer-observers-table)
1098            (hash-clear! module-defer-observers-table)
1099            (unlock-mutex module-defer-observers-mutex))))
1100    
1101    (define (module-call-observers m)
1102    (for-each (lambda (proc) (proc m)) (module-observers m))    (for-each (lambda (proc) (proc m)) (module-observers m))
1103    (hash-fold (lambda (id proc res) (proc m)) #f (module-weak-observers m)))    (hash-fold (lambda (id proc res) (proc m)) #f (module-weak-observers m)))
1104    
# Line 1267  Line 1293 
1293  ;; If no variable was already there, then create a new and uninitialzied  ;; If no variable was already there, then create a new and uninitialzied
1294  ;; variable.  ;; variable.
1295  ;;  ;;
1296    ;; This function is used in modules.c.
1297    ;;
1298  (define (module-make-local-var! m v)  (define (module-make-local-var! m v)
1299    (or (let ((b (module-obarray-ref (module-obarray m) v)))    (or (let ((b (module-obarray-ref (module-obarray m) v)))
1300          (and (variable? b)          (and (variable? b)
1301               (begin               (begin
1302                   ;; Mark as modified since this function is called when
1303                   ;; the standard eval closure defines a binding
1304                 (module-modified m)                 (module-modified m)
1305                 b)))                 b)))
1306        (and (module-binder m)        (and (module-binder m)
1307             ((module-binder m) m v #t))             ((module-binder m) m v #t))
1308        (begin        (begin
1309          (let ((answer (make-undefined-variable)))          (let ((answer (make-undefined-variable)))
1310            (module-obarray-set! (module-obarray m) v answer)            (module-add! m v answer)
           (module-modified m)  
1311            answer))))            answer))))
1312    
1313  ;; module-ensure-local-variable! module symbol  ;; module-ensure-local-variable! module symbol
# Line 1731  Line 1760 
1760            (set-module-name! custom-i name)            (set-module-name! custom-i name)
1761            ;; XXX - should use a lazy binder so that changes to the            ;; XXX - should use a lazy binder so that changes to the
1762            ;; used module are picked up automatically.            ;; used module are picked up automatically.
1763            (for-each (lambda (bspec)            (for-each (lambda (bspec)
1764                        (let* ((direct? (symbol? bspec))                        (let* ((direct? (symbol? bspec))
1765                               (orig (if direct? bspec (car bspec)))                               (orig (if direct? bspec (car bspec)))
1766                               (seen (if direct? bspec (cdr bspec)))                               (seen (if direct? bspec (cdr bspec)))
1767                               (var (or (module-local-variable public-i orig)                               (var (or (module-local-variable public-i orig)
1768                                        (module-local-variable module orig)                                        (module-local-variable module orig)
1769                                        (error                                        (error
# Line 1747  Line 1776 
1776                              (module-add! custom-i                              (module-add! custom-i
1777                                           (renamer seen)                                           (renamer seen)
1778                                           var))))                                           var))))
1779                      selection)                      selection)
1780            ;; Check that we are not hiding bindings which don't exist            ;; Check that we are not hiding bindings which don't exist
1781            (for-each (lambda (binding)            (for-each (lambda (binding)
1782                        (if (not (module-local-variable public-i binding))                        (if (not (module-local-variable public-i binding))
# Line 1778  Line 1807 
1807                 (re-exports '())                 (re-exports '())
1808                 (replacements '()))                 (replacements '()))
1809        (if (null? kws)        (if (null? kws)
1810            (begin            (call-with-deferred-observers
1811              (module-use-interfaces! module (reverse reversed-interfaces))             (lambda ()
1812              (module-export! module exports)               (module-use-interfaces! module (reverse reversed-interfaces))
1813              (module-replace! module replacements)               (module-export! module exports)
1814              (module-re-export! module re-exports))               (module-replace! module replacements)
1815                 (module-re-export! module re-exports)))
1816            (case (car kws)            (case (car kws)
1817              ((#:use-module #:use-syntax)              ((#:use-module #:use-syntax)
1818               (or (pair? (cdr kws))               (or (pair? (cdr kws))
# Line 2639  Line 2669 
2669  ;; to change scm_c_use_module as well.  ;; to change scm_c_use_module as well.
2670    
2671  (define (process-use-modules module-interface-args)  (define (process-use-modules module-interface-args)
2672    (module-use-interfaces! (current-module)    (let ((interfaces (map (lambda (mif-args)
2673                            (map (lambda (mif-args)                             (or (apply resolve-interface mif-args)
2674                                   (or (apply resolve-interface mif-args)                                 (error "no such module" mif-args)))
2675                                       (error "no such module" mif-args)))                           module-interface-args)))
2676                                 module-interface-args)))      (call-with-deferred-observers
2677         (lambda ()
2678           (module-use-interfaces! (current-module) interfaces)))))
2679    
2680  (defmacro use-modules modules  (defmacro use-modules modules
2681    `(eval-case    `(eval-case
# Line 2703  Line 2735 
2735     (#t     (#t
2736      (let ((name (defined-name (car args))))      (let ((name (defined-name (car args))))
2737        `(begin        `(begin
2738           (eval-case ((load-toplevel) (export ,name)))           (eval-case ((load-toplevel) (export-syntax ,name)))
2739           (defmacro ,@args))))))           (defmacro ,@args))))))
2740    
2741  ;; Export a local variable  ;; Export a local variable
# Line 2743  Line 2775 
2775  (defmacro export names  (defmacro export names
2776    `(eval-case    `(eval-case
2777      ((load-toplevel)      ((load-toplevel)
2778       (module-export! (current-module) ',names))       (call-with-deferred-observers
2779          (lambda ()
2780            (module-export! (current-module) ',names))))
2781      (else      (else
2782       (error "export can only be used at the top level"))))       (error "export can only be used at the top level"))))
2783    
2784  (defmacro re-export names  (defmacro re-export names
2785    `(eval-case    `(eval-case
2786      ((load-toplevel)      ((load-toplevel)
2787       (module-re-export! (current-module) ',names))       (call-with-deferred-observers
2788          (lambda ()
2789            (module-re-export! (current-module) ',names))))
2790      (else      (else
2791       (error "re-export can only be used at the top level"))))       (error "re-export can only be used at the top level"))))
2792    

Legend:
Removed from v.1.305  
changed lines
  Added in v.1.306

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26