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