unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* Evolution & optimization of the module system
@ 2007-02-17 15:15 Ludovic Courtès
  2007-02-18 23:32 ` Kevin Ryde
  0 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2007-02-17 15:15 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 7052 bytes --]

Hi,

The patch below (against HEAD) is a proposal to "improve" the module
system in several ways:

  1. Remove inconsistencies in how it behaves.

  2. Get better documentation and test coverage.

  3. Improve performance.

(1) has to do mainly with `module-use!' vs. `module-use-interfaces!' (as
was discussed recently).  Namely the fact that duplicate processing is
not always performed, depending on whether one uses `module-use!' or
some other means to use a module.  The patch solves this issue by making
duplicate processing inescapable.  Likewise, variable lookup currently
has two implementations (which have the same behavior, though): the C
`module_variable ()' and the Scheme `module-variable'.  The patch leaves
only one implementation of that.

There's still more to do to achieve (2) (notably actual documentation
;-)) but it's getting better.  Hopefully `modules.test' could eventually
cover enough of the API to serve as a "documentation".

(3) is two-fold:

  3.a. Duplicate processing.

  3.b. Variable lookup.

Although duplicates should be the exception rather than the rule[*],
duplicate processing is pretty costly: the current `process-duplicates'
is roughly O(N*USES), where N is the number of bindings in the interface
to be imported and USES is the number of modules currently used by the
module (because `module-import-interface' is O(USES)).
`module-use-interfaces!' is also terribly costly (calculating its
complexity is left as an exercise to the reader ;-)).  Likewise,
variable lookup (e.g., in `module_variable ()') is O(USES).  I believe
that both may have a sensible impact on startup time.

The patch addresses this by changing the data structures used by
modules: instead of a list of used modules, it uses a second "obarray",
called the "import obarray", that maps symbols to the modules providing
them.  This makes duplicates processing O(N) where N is the number of
bindings in the module to be imported, and variable lookup time is
independent of the number of modules imported.  The import obarray is
populated when `module-use!' is invoked (e.g., when `define-module' or
`use-modules' is processed).  Because of this, autoloading can no longer
be implemented using `make-autoload-interface' (otherwise, modules would
get loaded immediately, during `process-duplicates'): instead, the new
`module-autoload!' modifies the binder of the user module.

The module system allows bindings to be added dynamically to a module
(e.g., with `module-define!') in such a way that the newly added binding
is immediately visible to the module users.  In order to retain these
semantics, modules in the patched version have to "observe" the modules
they use in order to update their "import obarray" upon modification of
the used modules.  This is achieved using weak observers where the
observer procedure invokes `process-duplicates' when a used module is
changed.

This has several implications.  First, duplicate processing occurs the
same way for dynamically added bindings than for "statically imported"
bindings.  Second, it makes load-time-dependent duplicate policies such
as `last' and `first' irrelevant (since they are inherently
non-deterministic).  Imagine a module that loads `srfi-34' (after
THE-SCM-MODULE) and then update its import obarray as a result of a
modification in THE-SCM-MODULE: the update will replace the previous
value of `raise' (that from `srfi-34') with the core binding for
`raise'.  Third, it makes dynamic addition of bindings relatively
costly.  For instance, adding bindings at run-time to THE-SCM-MODULE can
yield to the duplicate processing all already loaded modules.

GOOPS makes use of `module-define!' after `(oop goops)' is used by the
various GOOPS modules, specifically in `create_smob_classes ()' so that
`(oop goops)' exports classes for all SMOB types (`<module>', etc.).  In
order to work around this problem, the patch modifies GOOPS so that (1)
`(oop goops)' exports only a predefined set of SMOB classes, and (2) the
SMOB classes are added to a separate module called `(oop goops
smob-classes)'.  Since only `(oop goops)' uses it, it is the only one
that needs to re-process duplicates as new SMOB classes are added.



>From a performance viewpoint, the improvement yielded by the new
`process-duplicates' is significant.  It can be observed by
(synthetically) creating a new module, having it import hundreds of
modules with tens of bindings, and then invoking:

  (module-use-interfaces! m (list the-modules-to-import))

(`module-use-interfaces!' already invokes `process-duplicates' in
current Guile.)  From the measurements I've made, the new version is
around 40 times faster than the other one.

The change in variable lookup time can be measured using the worst case,
namely by looking up variables that do not exist in the module---this is
arguably unfair to the current module implementation.  Again, there is a
significant difference between both implementations (since the patched
version is almost instantaneous):

  (module-ref a-module-that-imports-lots-of-modules (gensym))

However, the module construction cost is much higher with the new data
structure since `beautify-user-module!' has to populate the user
module's import obarray instead of just appending a module to its uses
list.  This is optimized by caching a standard module import obarray (in
`%scm-import-obarray') and then simply copying it in
`beautify-user-module!', using the new `hash-table-copy' primitive.
Without `hash-table-copy', the new `beautify-user-module!' is more than
200 times slower than the old one.  With `hash-table-copy', it is "only"
100 times slower.

The tiny script at [0] contains tools and instructions to reproduce
these measurements.



So the question is: is the `beautify-user-module!' overhead compensated
by the variable lookup and duplicate processing gains?

An application of mine [1], although it modifies `the-scm-module' at
run-time, requiring 40 modules to re-process duplicates, has its
execution time reduced by 8% (on a run that loads around 100 modules).
The whole test suite runs about 10% faster with the modified version
(although it has a larger `modules.test').  So it seems to be beneficial
performance-wise.  I'd be happy if people could try it out with other
applications (e.g., Lilypond ;-)) and measure the difference it makes.



Algorithmically, the module system could be further optimized by
removing the use list computation from `module-use!' (the use list is
used by `cond-expand', but `module-uses' could be implemented by
traversing the module obarray).  It could also be "micro-optimized" by
removing the "eval closure" indirection since it does not seem to be
useful.

I hope this long email will lead to a warm discussion!  :-)

Thanks,
Ludovic.

PS: The patch is still drafty.


[*] R6RS libraries _disallow_ duplicate binding imports:
    http://www.r6rs.org/document/html/r6rs-Z-H-2.html#node_toc_node_sec_6.1

[0] http://www.laas.fr/~lcourtes/software/guile/module-duplicates.scm
[1] http://www.nongnu.org/skribilo/



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The module system patch --]
[-- Type: text/x-patch, Size: 48366 bytes --]

--- orig/ice-9/boot-9.scm
+++ mod/ice-9/boot-9.scm
@@ -1100,8 +1100,6 @@
 ;;;
 ;;; - duplicates-handlers
 ;;;
-;;; - duplicates-interface
-;;;
 ;;; - observers
 ;;;
 ;;; - weak-observers
@@ -1173,8 +1171,10 @@
 (define module-type
   (make-record-type 'module
 		    '(obarray uses binder eval-closure transformer name kind
-		      duplicates-handlers duplicates-interface
-		      observers weak-observers observer-id)
+		      duplicates-handlers
+                      duplicates-interface ;; FIXME: to be removed
+		      observers weak-observers observer-id
+		      import-obarray)
 		    %print-module))
 
 ;; make-module &opt size uses binder
@@ -1190,6 +1190,10 @@
 	    (list-ref args index)
 	    default))
 
+      (define %default-import-size
+        ;; This should be the size of the pre-module obarray.
+        500)
+
       (if (> (length args) 3)
 	  (error "Too many args to make-module." args))
 
@@ -1209,8 +1213,9 @@
 	(let ((module (module-constructor (make-hash-table size)
 					  uses binder #f #f #f #f #f #f
 					  '()
-					  (make-weak-value-hash-table 31)
-					  0)))
+					  (make-weak-key-hash-table 31)
+					  0
+					  (make-hash-table %default-import-size))))
 
 	  ;; We can't pass this as an argument to module-constructor,
 	  ;; because we need it to close over a pointer to the module
@@ -1240,10 +1245,6 @@
   (record-accessor module-type 'duplicates-handlers))
 (define set-module-duplicates-handlers!
   (record-modifier module-type 'duplicates-handlers))
-(define module-duplicates-interface
-  (record-accessor module-type 'duplicates-interface))
-(define set-module-duplicates-interface!
-  (record-modifier module-type 'duplicates-interface))
 (define module-observers (record-accessor module-type 'observers))
 (define set-module-observers! (record-modifier module-type 'observers))
 (define module-weak-observers (record-accessor module-type 'weak-observers))
@@ -1251,6 +1252,9 @@
 (define set-module-observer-id! (record-modifier module-type 'observer-id))
 (define module? (record-predicate module-type))
 
+(define module-import-obarray (record-accessor module-type 'import-obarray))
+(define set-module-import-obarray! (record-modifier module-type 'import-obarray))
+
 (define set-module-eval-closure!
   (let ((setter (record-modifier module-type 'eval-closure)))
     (lambda (module closure)
@@ -1269,11 +1273,10 @@
   (set-module-observers! module (cons proc (module-observers module)))
   (cons module proc))
 
-(define (module-observe-weak module proc)
-  (let ((id (module-observer-id module)))
-    (hash-set! (module-weak-observers module) id proc)
-    (set-module-observer-id! module (+ 1 id))
-    (cons module id)))
+(define (module-observe-weak module observer-id . proc)
+  (let ((id (if (null? proc) (gensym) observer-id))
+        (proc (if (null? proc) observer-id (car proc))))
+    (hashq-set! (module-weak-observers module) observer-id proc)))
 
 (define (module-unobserve token)
   (let ((module (car token))
@@ -1311,7 +1314,11 @@
 
 (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)))
+
+  ;; We assume that weak observers don't (un)register themselves as they are
+  ;; called since this would preclude proper iteration over the hash table
+  ;; elements.
+  (hash-for-each (lambda (id proc) (proc m)) (module-weak-observers m)))
 
 \f
 
@@ -1435,26 +1442,8 @@
 ;;;
 ;;; If the symbol is not found at all, return #f.
 ;;;
-(define (module-local-variable m v)
-;  (caddr
-;   (list m v
-	 (let ((b (module-obarray-ref (module-obarray m) v)))
-	   (or (and (variable? b) b)
-	       (and (module-binder m)
-		    ((module-binder m) m v #f)))))
-;))
-
-;; module-variable module symbol
-;;
-;; like module-local-variable, except search the uses in the
-;; case V is not found in M.
-;;
-;; NOTE: This function is superseded with C code (see modules.c)
-;;;      when using the standard eval closure.
-;;
-(define (module-variable m v)
-  (module-search module-local-variable m v))
-
+;;; (This is now written in C, see `modules.c'.)
+;;;
 
 ;;; {Mapping modules x symbols --> bindings}
 ;;;
@@ -1515,19 +1504,10 @@
 	       (module-modified m)
 	       b)))
 
-      ;; No local variable yet, so we need to create a new one.  That
-      ;; new variable is initialized with the old imported value of V,
-      ;; if there is one.
-      (let ((imported-var (module-variable m v))
-	    (local-var (or (and (module-binder m)
-				((module-binder m) m v #t))
-			   (begin
-			     (let ((answer (make-undefined-variable)))
-			       (module-add! m v answer)
-			       answer)))))
-	(if (and imported-var (not (variable-bound? local-var)))
-	    (variable-set! local-var (variable-ref imported-var)))
-	local-var)))
+      ;; Create a new local variable.
+      (let ((local-var (make-undefined-variable)))
+        (module-add! m v local-var)
+        local-var)))
 
 ;; module-ensure-local-variable! module symbol
 ;;
@@ -1696,46 +1676,41 @@
 ;; Add INTERFACE to the list of interfaces used by MODULE.
 ;;
 (define (module-use! module interface)
-  (set-module-uses! module
-		    (cons interface
-			  (filter (lambda (m)
-				    (not (equal? (module-name m)
-						 (module-name interface))))
-				  (module-uses module))))
-  (module-modified module))
+  ;; Perform duplicate checking, thereby populating the `import-obarray' of
+  ;; MODULE.
+  (if (not (eq? module interface))
+      (begin
+        (process-duplicates module interface)
+
+        (set-module-uses! module
+                          (cons interface
+                                (filter (lambda (m)
+                                          (not
+                                           (equal? (module-name m)
+                                                   (module-name interface))))
+                                        (module-uses module))))
+
+        ;; Prepare to update MODULE's import obarray when INTERFACE changes.
+        ;; This can happen if dynamic module modification features like
+        ;; `module-define!' are used, but also, more commonly, in the case of
+        ;; mutually dependent modules (circular dependency).
+        (module-observe-weak interface module
+                             (lambda (interface)
+                               ;;(format (current-error-port)
+                               ;;        "iface ~a changed, updating module ~a~%"
+                               ;;        interface module)
+                               (process-duplicates module interface)))
+
+        (module-modified module))))
 
 ;; MODULE-USE-INTERFACES! module interfaces
 ;;
 ;; Same as MODULE-USE! but add multiple interfaces and check for duplicates
 ;;
 (define (module-use-interfaces! module interfaces)
-  (let* ((duplicates-handlers? (or (module-duplicates-handlers module)
-				   (default-duplicate-binding-procedures)))
-	 (uses (module-uses module)))
-    ;; remove duplicates-interface
-    (set! uses (delq! (module-duplicates-interface module) uses))
-    ;; remove interfaces to be added
-    (for-each (lambda (interface)
-		(set! uses
-		      (filter (lambda (m)
-				(not (equal? (module-name m)
-					     (module-name interface))))
-			      uses)))
-	      interfaces)
-    ;; add interfaces to use list
-    (set-module-uses! module uses)
-    (for-each (lambda (interface)
-		(and duplicates-handlers?
-		     ;; perform duplicate checking
-		     (process-duplicates module interface))
-		(set! uses (cons interface uses))
-		(set-module-uses! module uses))
-	      interfaces)
-    ;; add duplicates interface
-    (if (module-duplicates-interface module)
-	(set-module-uses! module
-			  (cons (module-duplicates-interface module) uses)))
-    (module-modified module)))
+  (for-each (lambda (interface)
+              (module-use! module interface))
+            interfaces))
 
 \f
 
@@ -1861,8 +1836,20 @@
 	  (set-module-public-interface! module interface))))
   (if (and (not (memq the-scm-module (module-uses module)))
 	   (not (eq? module the-root-module)))
-      (set-module-uses! module
-			(append (module-uses module) (list the-scm-module)))))
+      ;; Import the default set of bindings (from the SCM module) in MODULE
+      ;; and process duplicates between the SCM module and MODULE.
+      (begin
+        ;; Copy the pre-compiled import obarray for `the-scm-module'.  This
+        ;; is twice as fast as populating a new hash table by iterating over
+        ;; the bindings of `the-scm-module'.
+        (set-module-import-obarray! module
+                                    (hash-table-copy %scm-import-obarray))
+        (module-observe-weak the-scm-module module
+                             (lambda (interface)
+                               ;;(format (current-error-port)
+                               ;;        "~%~%root module changed, updating module ~a~%"
+                               ;;        module)
+                               (process-duplicates module interface))))))
 
 ;; NOTE: This binding is used in libguile/modules.c.
 ;;
@@ -2007,6 +1994,10 @@
 			    #f "no binding `~A' to hide in module ~A"
 			    binding name))))
 		    hide)
+
+          ;; XXX: Such modules are _not_ updated when the interfaces they use
+          ;; are modified!
+
           custom-i))))
 
 (define (symbol-prefix-proc prefix)
@@ -2027,7 +2018,8 @@
 	       (reversed-interfaces '())
 	       (exports '())
 	       (re-exports '())
-	       (replacements '()))
+	       (replacements '())
+               (autoloads '()))
 
       (if (null? kws)
 	  (call-with-deferred-observers
@@ -2035,7 +2027,9 @@
 	     (module-use-interfaces! module (reverse reversed-interfaces))
 	     (module-export! module exports)
 	     (module-replace! module replacements)
-	     (module-re-export! module re-exports)))
+	     (module-re-export! module re-exports)
+             (if (not (null? autoloads))
+                 (apply module-autoload! module autoloads))))
 	  (case (car kws)
 	    ((#:use-module #:use-syntax)
 	     (or (pair? (cdr kws))
@@ -2055,31 +2049,35 @@
 		     (cons interface reversed-interfaces)
 		     exports
 		     re-exports
-		     replacements)))
+		     replacements
+                     autoloads)))
 	    ((#:autoload)
 	     (or (and (pair? (cdr kws)) (pair? (cddr kws)))
 		 (unrecognized kws))
 	     (loop (cdddr kws)
-		   (cons (make-autoload-interface module
-						  (cadr kws)
-						  (caddr kws))
-			 reversed-interfaces)
+                   reversed-interfaces
 		   exports
 		   re-exports
-		   replacements))
+		   replacements
+                   (let ((name (cadr kws))
+                         (bindings (caddr kws)))
+                     (cons* name bindings autoloads))))
 	    ((#:no-backtrace)
 	     (set-system-module! module #t)
-	     (loop (cdr kws) reversed-interfaces exports re-exports replacements))
+	     (loop (cdr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
 	    ((#:pure)
 	     (purify-module! module)
-	     (loop (cdr kws) reversed-interfaces exports re-exports replacements))
+	     (loop (cdr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
 	    ((#:duplicates)
 	     (if (not (pair? (cdr kws)))
 		 (unrecognized kws))
 	     (set-module-duplicates-handlers!
 	      module
 	      (lookup-duplicates-handlers (cadr kws)))
-	     (loop (cddr kws) reversed-interfaces exports re-exports replacements))
+	     (loop (cddr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
 	    ((#:export #:export-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
@@ -2087,7 +2085,8 @@
 		   reversed-interfaces
 		   (append (cadr kws) exports)
 		   re-exports
-		   replacements))
+		   replacements
+                   autoloads))
 	    ((#:re-export #:re-export-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
@@ -2095,7 +2094,8 @@
 		   reversed-interfaces
 		   exports
 		   (append (cadr kws) re-exports)
-		   replacements))
+		   replacements
+                   autoloads))
 	    ((#:replace #:replace-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
@@ -2103,7 +2103,8 @@
 		   reversed-interfaces
 		   exports
 		   re-exports
-		   (append (cadr kws) replacements)))
+		   (append (cadr kws) replacements)
+                   autoloads))
 	    (else
 	     (unrecognized kws)))))
     (run-hook module-defined-hook module)
@@ -2119,20 +2120,64 @@
 ;;; {Autoload}
 ;;;
 
-(define (make-autoload-interface module name bindings)
-  (let ((b (lambda (a sym definep)
-	     (and (memq sym bindings)
-		  (let ((i (module-public-interface (resolve-module name))))
-		    (if (not i)
-			(error "missing interface for module" name))
-		    (let ((autoload (memq a (module-uses module))))
-		      ;; Replace autoload-interface with actual interface if
-		      ;; that has not happened yet.
-		      (if (pair? autoload)
-			  (set-car! autoload i)))
-		    (module-local-variable i sym))))))
-    (module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f #f
-			'() (make-weak-value-hash-table 31) 0)))
+(define (module-autoload! module . name+binding)
+  "Have @var{module} autoload the given module for the specified bindings.
+For instance, @code{(module-autoload! m '(ice-9 debugger) '(debug))} results
+in @var{m} autoloading module @code{(ice-9 debugger)} whenever binding
+@code{debug} is accessed."
+
+  (define (binding->name-alist name+binding)
+    (let loop ((binding->name '())
+               (name+binding name+binding))
+      (if (null? name+binding)
+          binding->name
+          (let ((module-name (car name+binding))
+                (bindings (cadr name+binding)))
+            (loop (append (map (lambda (binding)
+                                 (cons binding module-name))
+                               bindings)
+                          binding->name)
+                  (cddr name+binding))))))
+
+  (let* ((binding-alist (binding->name-alist name+binding))
+         (binder (module-binder module))
+         (new-binder
+          (lambda (a sym define?)
+            (or (and (procedure? binder)
+                     (binder a sym define?))
+                (let* ((bind (assq sym binding-alist))
+                       (module-name (and (pair? bind) (cdr bind))))
+                  (and module-name
+                       (let ((i (module-public-interface
+                                 (resolve-module module-name))))
+                         (if (not i)
+                             (error "missing interface for module" name))
+
+                         ;;(format #t "autoloaded ~a for ~a because of ~a~%"
+                         ;;        module-name module sym)
+
+                         (set! binding-alist
+                               (assq-remove! binding-alist sym))
+                         (module-use-interfaces! module (list i))
+
+                         (module-variable i sym))))))))
+
+    ;; Make sure the given bindings are not already imported.  This allows
+    ;; autoloading to work even when the triggering symbols would replace
+    ;; already existing bindings.  IOW, this sets a special duplicate
+    ;; handling policy where the explicitly autoloaded symbols override other
+    ;; same-named imported symbols.
+    (let ((imports (module-import-obarray module)))
+      (let loop ((name+binding name+binding))
+        (if (not (null? name+binding))
+            (let ((bindings (cadr name+binding)))
+              (for-each (lambda (autoloaded-binding)
+                          (hashq-set! imports autoloaded-binding #f))
+                        bindings)
+              (loop (cddr name+binding))))))
+
+    ;; Install the new binder.
+    (set-module-binder! module new-binder)))
 
 ;;; {Compiled module}
 
@@ -3133,34 +3178,38 @@
 			      (lookup-duplicates-handlers handler-names))
 			    handler-names)))
 
-(define (make-duplicates-interface)
-  (let ((m (make-module)))
-    (set-module-kind! m 'custom-interface)
-    (set-module-name! m 'duplicates)
-    m))
-
 (define (process-duplicates module interface)
+  ;; Process duplicate bindings as MODULE imports INTERFACE (typically a
+  ;; module's public interface).
+
+  (define (%module-for-each proc module)
+    ;; Some modules re-export bindings from other modules.  They do so by
+    ;; having the public interface import the public interface of those other
+    ;; bindings (see, e.g., `(oop goops internal)').  Thus, we must traverse
+    ;; both bindings internal to INTERFACE and bindings _imported_ by
+    ;; INTERFACE.
+    (hash-for-each proc (module-obarray module))
+    (hash-for-each (lambda (sym interface)
+                     (let ((var (module-variable interface sym)))
+                       (if (not var)
+                           (format (current-error-port) "`~a' from `~a' => ~a~%"
+                                   sym interface var))
+                       (proc sym var)))
+                   (module-import-obarray module)))
+
   (let* ((duplicates-handlers (or (module-duplicates-handlers module)
 				  (default-duplicate-binding-procedures)))
-	 (duplicates-interface (module-duplicates-interface module)))
-    (module-for-each
+	 (imports (module-import-obarray module)))
+    (%module-for-each
      (lambda (name var)
-       (cond ((module-import-interface module name)
+       (cond ((hashq-ref imports name)
 	      =>
 	      (lambda (prev-interface)
-		(let ((var1 (module-local-variable prev-interface name))
-		      (var2 (module-local-variable interface name)))
+		(let ((var1 (module-variable prev-interface name))
+		      (var2 (module-variable interface name)))
 		  (if (not (eq? var1 var2))
 		      (begin
-			(if (not duplicates-interface)
-			    (begin
-			      (set! duplicates-interface
-				    (make-duplicates-interface))
-			      (set-module-duplicates-interface!
-			       module
-			       duplicates-interface)))
-			(let* ((var (module-local-variable duplicates-interface
-							   name))
+			(let* ((var var1)
 			       (val (and var
 					 (variable-bound? var)
 					 (variable-ref var))))
@@ -3179,9 +3228,14 @@
 				    val)
 				   =>
 				   (lambda (var)
-				     (module-add! duplicates-interface name var)))
+				     (hashq-set! imports name
+						 (if (eq? var1 var)
+						     prev-interface
+						     interface))))
 				  (else
-				   (loop (cdr duplicates-handlers)))))))))))))
+				   (loop (cdr duplicates-handlers)))))))))))
+	     (else
+	      (hashq-set! imports name interface))))
      interface)))
 
 \f
@@ -3398,10 +3452,7 @@
 	  '(((ice-9 threads)))
 	  '())))
     ;; load debugger on demand
-    (module-use! guile-user-module
-		 (make-autoload-interface guile-user-module
-					  '(ice-9 debugger) '(debug)))
-
+    (module-autoload! guile-user-module '(ice-9 debugger) '(debug))
 
     ;; Note: SIGFPE, SIGSEGV and SIGBUS are actually "query-only" (see
     ;; scmsigs.c scm_sigaction_for_thread), so the handlers setup here have
@@ -3477,6 +3528,30 @@
 
 \f
 
+(define %scm-import-obarray
+  ;; A pre-compiled "import obarray" for use by modules that use
+  ;; `the-scm-module'.  This allows to halve the time spent in
+  ;; `beautify-user-module!'.
+  (begin
+    (define (make-scm-import-obarray)
+      (let ((imports (make-hash-table 2000)))
+        (module-for-each (lambda (sym var)
+                           (hashq-set! imports sym the-scm-module))
+                         the-scm-module)
+        imports))
+
+    (module-observe-weak the-scm-module #t
+                         (lambda (interface)
+                           ;; Update it.
+                           (format (current-error-port)
+                                   "updating `%scm-import-obarray'~%")
+                           (set! %scm-import-obarray
+                                 (make-scm-import-obarray))))
+
+    (make-scm-import-obarray)))
+
+\f
+
 ;;; Place the user in the guile-user module.
 ;;;
 

--- orig/libguile/goops.c
+++ mod/libguile/goops.c
@@ -2587,10 +2587,14 @@
  *
  **********************************************************************/
 
+/* A module holding SMOB classes.  */
+static SCM smob_class_module = SCM_UNSPECIFIED;
+
 static SCM
 make_class_from_template (char const *template, char const *type_name, SCM supers, int applicablep)
 {
   SCM class, name;
+
   if (type_name)
     {
       char buffer[100];
@@ -2609,8 +2613,12 @@
 
   /* Only define name if doesn't already exist. */
   if (!SCM_GOOPS_UNBOUNDP (name)
-      && scm_is_false (scm_call_2 (scm_goops_lookup_closure, name, SCM_BOOL_F)))
-    DEFVAR (name, class);
+      && scm_is_false (scm_module_local_variable (smob_class_module, name)))
+    {
+      scm_module_define (smob_class_module, name, class);
+      scm_module_export (smob_class_module, scm_list_1 (name));
+    }
+
   return class;
 }
 
@@ -2665,6 +2673,11 @@
 {
   long i;
 
+  /* Create the module that will hold the SMOB classes.  */
+  smob_class_module = scm_c_define_module ("oop goops smob-classes",
+					   NULL, NULL);
+  smob_class_module = scm_permanent_object (smob_class_module);
+
   scm_smob_class = (SCM *) scm_malloc (255 * sizeof (SCM));
   for (i = 0; i < 255; ++i)
     scm_smob_class[i] = 0;


--- orig/libguile/hashtab.c
+++ mod/libguile/hashtab.c
@@ -76,37 +76,65 @@
 
 #define HASHTABLE_SIZE_N (sizeof(hashtable_size)/sizeof(unsigned long))
 
+static inline unsigned long
+find_suitable_bucket_count (unsigned long element_count, int *size_index)
+{
+  unsigned i = 0;
+
+  while (i < HASHTABLE_SIZE_N && element_count > hashtable_size[i])
+    ++i;
+
+  *size_index = i;
+
+  return (hashtable_size[i]);
+}
+
+
 static char *s_hashtable = "hashtable";
 
 SCM weak_hashtables = SCM_EOL;
 
+static inline SCM
+make_hash_table_from_buckets (SCM buckets, scm_t_hashtable *c_table, int flags)
+{
+  SCM table, link;
+
+  if (flags)
+    link = weak_hashtables;
+  else
+    link = SCM_EOL;
+
+  SCM_NEWSMOB3 (table, scm_tc16_hashtable, buckets, c_table, link);
+
+  if (flags)
+    weak_hashtables = table;
+
+  return table;
+}
+
 static SCM
 make_hash_table (int flags, unsigned long k, const char *func_name) 
 {
   SCM table, vector;
   scm_t_hashtable *t;
-  int i = 0, n = k ? k : 31;
-  while (i < HASHTABLE_SIZE_N && n > hashtable_size[i])
-    ++i;
-  n = hashtable_size[i];
+  int size_index = 0, n = k ? k : 31;
+
+  n = find_suitable_bucket_count (k, &size_index);
+
   if (flags)
     vector = scm_i_allocate_weak_vector (flags, scm_from_int (n), SCM_EOL);
   else
     vector = scm_c_make_vector (n, SCM_EOL);
   t = scm_gc_malloc (sizeof (*t), s_hashtable);
-  t->min_size_index = t->size_index = i;
+  t->min_size_index = t->size_index = size_index;
   t->n_items = 0;
   t->lower = 0;
   t->upper = 9 * n / 10;
   t->flags = flags;
   t->hash_fn = NULL;
-  if (flags)
-    {
-      SCM_NEWSMOB3 (table, scm_tc16_hashtable, vector, t, weak_hashtables);
-      weak_hashtables = table;
-    }
-  else
-    SCM_NEWSMOB3 (table, scm_tc16_hashtable, vector, t, SCM_EOL);
+
+  table = make_hash_table_from_buckets (vector, t, flags);
+
   return table;
 }
 
@@ -309,6 +337,71 @@
 }
 #undef FUNC_NAME
 
+/* Copy the given alist, i.e., duplicate all its pairs recursively.  */
+static inline SCM
+alist_copy (SCM alist)
+{
+  SCM it, pair, result = SCM_EOL;
+
+  for (it = alist;
+       !scm_is_null (it);
+       it = SCM_CDR (it))
+    {
+      pair = SCM_CAR (it);
+      result = scm_cons (scm_cons (SCM_CAR (pair), SCM_CDR (pair)),
+			 result);
+    }
+
+  return result;
+}
+
+SCM_DEFINE (scm_hash_table_copy, "hash-table-copy", 1, 0, 0,
+	    (SCM table),
+	    "Return a newly allocated hash table whose contents are the "
+	    "same as those of @var{hashtab}.  This should be faster than "
+	    "traversing @var{table} and invoking @code{hash-set!} on a "
+	    "new (empty) table for each element since the new table will "
+	    "be readily balanced.")
+#define FUNC_NAME s_scm_hash_table_copy
+{
+  size_t bucket_count, i;
+  scm_t_hashtable *c_new_table = NULL;
+  SCM buckets, new_buckets, new_table;
+
+  if (SCM_HASHTABLE_P (table))
+    {
+      buckets = SCM_HASHTABLE_VECTOR (table);
+      c_new_table = scm_gc_malloc (sizeof (* c_new_table), s_hashtable);
+    }
+  else
+    {
+      SCM_VALIDATE_VECTOR (1, table);
+      buckets = table;
+    }
+
+  bucket_count = SCM_SIMPLE_VECTOR_LENGTH (buckets);
+  new_buckets = scm_c_make_vector (bucket_count, SCM_BOOL_F);
+
+  for (i = 0; i < bucket_count; i++)
+    {
+      SCM alist;
+
+      alist = alist_copy (SCM_SIMPLE_VECTOR_REF (buckets, i));
+      SCM_SIMPLE_VECTOR_SET (new_buckets, i, alist);
+    }
+
+  if (SCM_HASHTABLE_P (table))
+    {
+      *c_new_table = *SCM_HASHTABLE (table);
+      new_table = make_hash_table_from_buckets (new_buckets, c_new_table, 0);
+    }
+  else
+    new_table = new_buckets;
+
+  return new_table;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 0, 1, 0, 
 	    (SCM n),
 	    "@deffnx {Scheme Procedure} make-weak-value-hash-table size\n"
@@ -409,6 +502,9 @@
 #undef FUNC_NAME
 
 
+\f
+/* Accessors.  */
+
 SCM
 scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
 #define FUNC_NAME "scm_hash_fn_get_handle"


--- orig/libguile/modules.c
+++ mod/libguile/modules.c
@@ -162,12 +162,8 @@
 
 static SCM module_export_x_var;
 
-
-/*
-  TODO: should export this function? --hwn.
- */
-static SCM
-scm_export (SCM module, SCM namelist)
+SCM
+scm_module_export (SCM module, SCM namelist)
 {
   return scm_call_2 (SCM_VARIABLE_REF (module_export_x_var),
 		     module, namelist);
@@ -203,7 +199,7 @@
 	  tail = SCM_CDRLOC (*tail);
 	}
       va_end (ap);
-      scm_export (scm_current_module(), names);
+      scm_module_export (scm_current_module (), names);
     }
 }
 
@@ -280,40 +276,113 @@
 
 static SCM module_make_local_var_x_var;
 
-static SCM
-module_variable (SCM module, SCM sym)
+SCM_DEFINE (scm_module_local_variable, "module-local-variable", 2, 0, 0,
+	    (SCM module, SCM sym),
+	    "Return the variable bound to @var{sym} in @var{module}.  Return "
+	    "@code{#f} is @var{sym} is not bound locally in @var{module}.")
+#define FUNC_NAME s_scm_module_local_variable
 {
 #define SCM_BOUND_THING_P(b) \
   (scm_is_true (b))
 
+  register SCM b;
+
+  /* SCM_MODULE_TAG is not initialized yet when `boot-9.scm' is being
+     evaluated.  */
+  if (scm_module_system_booted_p)
+    SCM_VALIDATE_MODULE (1, module);
+
+  SCM_VALIDATE_SYMBOL (2, sym);
+
+
   /* 1. Check module obarray */
-  SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
+  b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
   if (SCM_BOUND_THING_P (b))
     return b;
+
+  /* 2. Search imported bindings.  In order to be consistent with
+     `module-variable', the binder gets called only when no imported binding
+     matches SYM.  */
+  b = scm_hashq_ref (SCM_MODULE_IMPORT_OBARRAY (module), sym, SCM_UNDEFINED);
+  if (SCM_BOUND_THING_P (b))
+    return SCM_BOOL_F;
+
   {
+    /* 3. Query the custom binder.  */
     SCM binder = SCM_MODULE_BINDER (module);
+
     if (scm_is_true (binder))
-      /* 2. Custom binder */
       {
 	b = scm_call_3 (binder, module, sym, SCM_BOOL_F);
 	if (SCM_BOUND_THING_P (b))
 	  return b;
       }
   }
+
+  return SCM_BOOL_F;
+
+#undef SCM_BOUND_THING_P
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_module_variable, "module-variable", 2, 0, 0,
+	    (SCM module, SCM sym),
+	    "Return the variable bound to @var{sym} in @var{module}.  This "
+	    "may be both a local variable or an imported variable.  Return "
+	    "@code{#f} is @var{sym} is not bound in @var{module}.")
+#define FUNC_NAME s_scm_module_variable
+{
+  SCM_VALIDATE_MODULE (1, module);
+  SCM_VALIDATE_SYMBOL (2, sym);
+
+#define SCM_BOUND_THING_P(b) \
+  (scm_is_true (b))
+
+  /* 1. Check module obarray */
+  register SCM b, binder;
+
+ lookup:
+  binder = SCM_MODULE_BINDER (module);
+
+  b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
+  if (SCM_BOUND_THING_P (b))
+    return b;
+
+  {
+    /* 2. Search imported bindings.  */
+    SCM iface, imports = SCM_MODULE_IMPORT_OBARRAY (module);
+
+    iface = scm_hashq_ref (imports, sym, SCM_UNDEFINED);
+    if (SCM_MODULEP (iface))
+      {
+	if (scm_is_false (binder))
+	  {
+	    /* Tail-recursive call.  */
+	    module = iface;
+	    goto lookup;
+	  }
+
+	b = scm_module_variable (iface, sym);
+	if (SCM_BOUND_THING_P (b))
+	  return b;
+      }
+  }
+
   {
-    /* 3. Search the use list */
-    SCM uses = SCM_MODULE_USES (module);
-    while (scm_is_pair (uses))
+    /* 3. Query the custom binder.  */
+    if (scm_is_true (binder))
       {
-	b = module_variable (SCM_CAR (uses), sym);
+	b = scm_call_3 (binder, module, sym, SCM_BOOL_F);
 	if (SCM_BOUND_THING_P (b))
 	  return b;
-	uses = SCM_CDR (uses);
       }
-    return SCM_BOOL_F;
   }
+
+  return SCM_BOOL_F;
+
 #undef SCM_BOUND_THING_P
 }
+#undef FUNC_NAME
 
 scm_t_bits scm_tc16_eval_closure;
 
@@ -335,7 +404,7 @@
 			 module, sym);
     }
   else
-    return module_variable (module, sym);
+    return scm_module_variable (module, sym);
 }
 
 SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0,
@@ -398,38 +467,16 @@
 
 SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
 	    (SCM module, SCM sym),
-	    "")
+	    "Return the module or interface from which @var{sym} is imported "
+	    "in @var{module}.  If @var{sym} is not imported (i.e., it is not "
+	    "defined in @var{module} or it is a module-local binding instead "
+	    "of an imported one), then @code{#f} is returned.")
 #define FUNC_NAME s_scm_module_import_interface
 {
-#define SCM_BOUND_THING_P(b) (scm_is_true (b))
-  SCM uses;
-  SCM_VALIDATE_MODULE (SCM_ARG1, module);
-  /* Search the use list */
-  uses = SCM_MODULE_USES (module);
-  while (scm_is_pair (uses))
-    {
-      SCM _interface = SCM_CAR (uses);
-      /* 1. Check module obarray */
-      SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (_interface), sym, SCM_BOOL_F);
-      if (SCM_BOUND_THING_P (b))
-	return _interface;
-      {
-	SCM binder = SCM_MODULE_BINDER (_interface);
-	if (scm_is_true (binder))
-	  /* 2. Custom binder */
-	  {
-	    b = scm_call_3 (binder, _interface, sym, SCM_BOOL_F);
-	    if (SCM_BOUND_THING_P (b))
-	      return _interface;
-	  }
-      }
-      /* 3. Search use list recursively. */
-      _interface = scm_module_import_interface (_interface, sym);
-      if (scm_is_true (_interface))
-	return _interface;
-      uses = SCM_CDR (uses);
-    }
-  return SCM_BOOL_F;
+  SCM_VALIDATE_MODULE (1, module);
+  SCM_VALIDATE_SYMBOL (2, sym);
+
+  return (scm_hashq_ref (SCM_MODULE_IMPORT_OBARRAY (module), sym, SCM_BOOL_F));
 }
 #undef FUNC_NAME
 
@@ -560,52 +607,76 @@
   return var;
 }
 
-SCM
-scm_module_reverse_lookup (SCM module, SCM variable)
-#define FUNC_NAME "module-reverse-lookup"
+SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
+	    (SCM module, SCM variable),
+	    "Return the symbol under which @var{variable} is bound in "
+	    "@var{module} or @var{#f} if @var{variable} is not visible "
+	    "from @var{module}.  If @var{module} is @code{#f}, then the "
+	    "pre-module obarray is used.")
+#define FUNC_NAME s_scm_module_reverse_lookup
 {
-  SCM obarray;
-  long i, n;
+  unsigned long i, n;
+  SCM obarray, import_obarray;
 
   if (scm_is_false (module))
-    obarray = scm_pre_modules_obarray;
+    {
+      obarray = scm_pre_modules_obarray;
+      import_obarray = SCM_BOOL_F;
+    }
   else
     {
       SCM_VALIDATE_MODULE (1, module);
       obarray = SCM_MODULE_OBARRAY (module);
+      import_obarray = SCM_MODULE_IMPORT_OBARRAY (module);
     }
 
-  if (!SCM_HASHTABLE_P (obarray))
-      return SCM_BOOL_F;
-
-  /* XXX - We do not use scm_hash_fold here to avoid searching the
-     whole obarray.  We should have a scm_hash_find procedure. */
+  SCM_VALIDATE_VARIABLE (2, variable);
 
+  /* Search the module's obarray.
+     XXX - We do not use scm_hash_fold here to avoid searching the whole
+     obarray.  We should have a scm_hash_find procedure. */
   n = SCM_HASHTABLE_N_BUCKETS (obarray);
   for (i = 0; i < n; ++i)
     {
-      SCM ls = SCM_HASHTABLE_BUCKET (obarray, i), handle;
-      while (!scm_is_null (ls))
+      SCM handle, ls;
+
+      for (ls = SCM_HASHTABLE_BUCKET (obarray, i);
+	   !scm_is_null (ls);
+	   ls = SCM_CDR (ls))
 	{
 	  handle = SCM_CAR (ls);
 	  if (SCM_CDR (handle) == variable)
 	    return SCM_CAR (handle);
-	  ls = SCM_CDR (ls);
 	}
     }
 
-  /* Try the `uses' list. 
-   */
-  {
-    SCM uses = SCM_MODULE_USES (module);
-    while (scm_is_pair (uses))
-      {
-	SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
-	if (scm_is_true (sym))
-	  return sym;
-	uses = SCM_CDR (uses);
-      }
-  }
+  if (scm_is_true (import_obarray))
+    {
+      /* Now, search the import obarray (which requires some more work).  */
+      n = SCM_HASHTABLE_N_BUCKETS (import_obarray);
+      for (i = 0; i < n; ++i)
+	{
+	  SCM handle, iface, ls;
+
+	  for (ls = SCM_HASHTABLE_BUCKET (import_obarray, i);
+	       !scm_is_null (ls);
+	       ls = SCM_CDR (ls))
+	    {
+	      handle = SCM_CAR (ls);
+	      iface = SCM_CDR (handle);
+	      if (SCM_MODULEP (iface))
+		{
+		  SCM sym, var;
+
+		  sym = SCM_CAR (handle);
+		  var = scm_module_variable (iface, sym);
+
+		  if (scm_is_eq (var, variable))
+		    return sym;
+		}
+	    }
+	}
+    }
 
   return SCM_BOOL_F;
 }


--- orig/libguile/modules.h
+++ mod/libguile/modules.h
@@ -45,6 +45,7 @@
 #define scm_module_index_binder		2
 #define scm_module_index_eval_closure	3
 #define scm_module_index_transformer	4
+#define scm_module_index_import_obarray 12
 
 #define SCM_MODULE_OBARRAY(module) \
   SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_obarray])
@@ -56,6 +57,8 @@
   SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure])
 #define SCM_MODULE_TRANSFORMER(module) \
   SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_transformer])
+#define SCM_MODULE_IMPORT_OBARRAY(module) \
+  SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_import_obarray])
 
 SCM_API scm_t_bits scm_tc16_eval_closure;
 
@@ -64,6 +67,8 @@
 \f
 
 SCM_API SCM scm_current_module (void);
+SCM_API SCM scm_module_variable (SCM module, SCM sym);
+SCM_API SCM scm_module_local_variable (SCM module, SCM sym);
 SCM_API SCM scm_interaction_environment (void);
 SCM_API SCM scm_set_current_module (SCM module);
 
@@ -80,6 +85,7 @@
 SCM_API SCM scm_c_module_define (SCM module, const char *name, SCM val);
 SCM_API SCM scm_module_lookup (SCM module, SCM symbol);
 SCM_API SCM scm_module_define (SCM module, SCM symbol, SCM val);
+SCM_API SCM scm_module_export (SCM module, SCM symbol_list);
 SCM_API SCM scm_module_reverse_lookup (SCM module, SCM variable);
 
 SCM_API SCM scm_c_resolve_module (const char *name);


--- orig/oop/goops.scm
+++ mod/oop/goops.scm
@@ -85,7 +85,67 @@
 ;; Then load the rest of GOOPS
 (use-modules (oop goops util)
 	     (oop goops dispatch)
-	     (oop goops compile))
+	     (oop goops compile)
+             (oop goops smob-classes))
+
+;; Re-export the SMOB classes defined in the `smob-classes' module.  The
+;; `smob-classes' module is a "virtual" module created and populated by
+;; `create_smob_classes ()'.
+
+(re-export ;; FIXME: We certainly don't need all of them.
+<free>
+<fluid>
+<dynamic-state>
+<hashtable>
+<continuation>
+<thread>
+<mutex>
+<condition-variable>
+<arbiter>
+<async>
+<frame>
+<winder>
+<hook>
+;;<allocated cell>
+<macro>
+<malloc>
+<eval-closure>
+<directory>
+<regexp>
+<srcprops>
+<character-set>
+<jmpbuffer>
+<pre-unwind-data>
+<guardian>
+<promise>
+<memoized>
+<debug-object>
+<random-state>
+<array>
+<enclosed-array>
+<bitvector>
+<dynamic-object>
+<uvec>
+<stack>
+<print-state>
+<module>
+<file-port>
+<file-input-port>
+<file-output-port>
+<file-input-output-port>
+<string-port>
+<string-input-port>
+<string-output-port>
+<string-input-output-port>
+<void-port>
+<void-input-port>
+<void-output-port>
+<void-input-output-port>
+<soft-port>
+<soft-input-port>
+<soft-output-port>
+<soft-input-output-port>)
+
 
 \f
 (define min-fixnum (- (expt 2 29)))


--- orig/oop/goops/internal.scm
+++ mod/oop/goops/internal.scm
@@ -21,5 +21,10 @@
 (define-module (oop goops internal)
   :use-module (oop goops))
 
-(set-module-uses! %module-public-interface
-		  (list (nested-ref the-root-module '(app modules oop goops))))
+;; Export all the bindings that are internal to `(oop goops)'.
+(let ((public-i (module-public-interface (current-module))))
+  (module-for-each (lambda (name var)
+                     (if (eq? name '%module-public-interface)
+                         #t
+                         (module-add! public-i name var)))
+                   (resolve-module '(oop goops))))


--- orig/srfi/srfi-34.scm
+++ mod/srfi/srfi-34.scm
@@ -27,8 +27,8 @@
 ;;; Code:
 
 (define-module (srfi srfi-34)
-  #:export (with-exception-handler
-	    raise)
+  #:export (with-exception-handler)
+  #:replace (raise)
   #:export-syntax (guard))
 
 (cond-expand-provide (current-module) '(srfi-34))


--- orig/test-suite/tests/hash.test
+++ mod/test-suite/tests/hash.test
@@ -72,3 +72,37 @@
 	     (hashx-set! hashq assq table 'x 123)
 	     (hashx-remove! hashq assq table 'x)
 	     (null? (hash-map->list noop table)))))
+
+;;;
+;;; hash-table-copy
+;;;
+
+(with-test-prefix "hash-table-copy"
+
+  (pass-if "hash-table"
+    (let ((table (make-hash-table))
+          (pair<? (lambda (p1 p2)
+                    (< (cdr p1) (cdr p2)))))
+      (hashq-set! table 'hello 1)
+      (hashq-set! table 'world 2)
+      (hashq-set! table '!     3)
+      (let ((new-table (hash-table-copy table)))
+        (and (hash-table? new-table)
+             (not (eq? (hashq-get-handle table 'hello)
+                       (hashq-get-handle new-table 'hello)))
+             (equal? (sort (hash-map->list cons table) pair<?)
+                     (sort (hash-map->list cons new-table) pair<?))))))
+
+  (pass-if "vector"
+    (let ((table (make-vector 33 '()))
+          (pair<? (lambda (p1 p2)
+                    (< (cdr p1) (cdr p2)))))
+      (hashq-set! table 'hello 1)
+      (hashq-set! table 'world 2)
+      (hashq-set! table '!     3)
+      (let ((new-table (hash-table-copy table)))
+        (and (vector? new-table)
+             (not (eq? (hashq-get-handle table 'hello)
+                       (hashq-get-handle new-table 'hello)))
+             (equal? (sort (hash-map->list cons table) pair<?)
+                     (sort (hash-map->list cons new-table) pair<?)))))))


--- orig/test-suite/tests/modules.test
+++ mod/test-suite/tests/modules.test
@@ -1,6 +1,6 @@
 ;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*-
 
-;;;; Copyright (C) 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -16,10 +16,268 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
-(use-modules (test-suite lib))
+(define-module (test-suite test-modules)
+  :use-module (srfi srfi-1)
+  :use-module ((ice-9 streams)  ;; for test purposes
+               #:renamer (symbol-prefix-proc 's:))
+  :use-module (test-suite lib))
+
+
+(define (every? . args)
+  (not (not (apply every args))))
+
+
+\f
+;;;
+;;; Foundations.
+;;;
+
+(with-test-prefix "foundations"
+
+  (pass-if "module-add!"
+    (let ((m (make-module))
+          (value (cons 'x 'y)))
+      (module-add! m 'something (make-variable value))
+      (eq? (module-ref m 'something) value)))
+
+  (pass-if "module-define!"
+    (let ((m (make-module))
+          (value (cons 'x 'y)))
+      (module-define! m 'something value)
+      (eq? (module-ref m 'something) value)))
+
+  (pass-if "module-use!"
+    (let ((m (make-module))
+          (import (make-module)))
+      (module-define! m 'something 'something)
+      (module-define! import 'imported 'imported)
+      (module-use! m import)
+      (and (eq? (module-ref m 'something) 'something)
+           (eq? (module-ref m 'imported)  'imported)
+           (module-local-variable m 'something)
+           (not (module-local-variable m 'imported))
+           #t)))
+
+  (pass-if "module-use! (duplicates local binding)"
+    ;; Imported bindings can't override locale bindings.
+    (let ((m (make-module))
+          (import (make-module)))
+      (module-define! m 'something 'something)
+      (module-define! import 'something 'imported)
+      (module-use! m import)
+      (eq? (module-ref m 'something) 'something)))
+
+  (pass-if "module-locally-bound?"
+     (let ((m (make-module))
+           (import (make-module)))
+       (module-define! m 'something #t)
+       (module-define! import 'imported #t)
+       (module-use! m import)
+       (and (module-locally-bound? m 'something)
+            (not (module-locally-bound? m 'imported)))))
+
+  (pass-if "module-{local-,}variable"
+     (let ((m (make-module))
+           (import (make-module)))
+       (module-define! m 'local #t)
+       (module-define! import 'imported #t)
+       (module-use! m import)
+       (and (module-local-variable m 'local)
+            (not (module-local-variable m 'imported))
+            (eq? (module-variable m 'local)
+                 (module-local-variable m 'local))
+            (eq? (module-local-variable import 'imported)
+                 (module-variable m 'imported)))))
+
+  (pass-if "module-import-interface"
+    (and (every? (lambda (sym iface)
+                   (eq? (module-import-interface (current-module) sym)
+                        iface))
+                 '(current-module exception:bad-variable every)
+                 (cons the-scm-module
+                       (map resolve-interface
+                            '((test-suite lib) (srfi srfi-1)))))
+
+         ;; For renamed bindings, a custom interface is used so we can't
+         ;; check for equality with `eq?'.
+         (every? (lambda (sym iface)
+                   (let ((import
+                          (module-import-interface (current-module) sym)))
+                     (equal? (module-name import)
+                             (module-name iface))))
+                 '(s:make-stream s:stream-car s:stream-cdr)
+                 (make-list 3 (resolve-interface '(ice-9 streams))))))
+
+  (pass-if "module-reverse-lookup"
+    (let ((mods   '((srfi srfi-1) (test-suite lib)      (ice-9 streams)))
+          (syms   '(every         exception:bad-variable make-stream))
+          (locals '(every         exception:bad-variable s:make-stream)))
+      (every? (lambda (var sym)
+                (eq? (module-reverse-lookup (current-module) var)
+                     sym))
+              (map module-variable
+                   (map resolve-interface mods)
+                   syms)
+              locals))))
+
+
+\f
+;;;
+;;; Observers.
+;;;
+
+(with-test-prefix "observers"
+
+  (pass-if "weak observer invoked"
+    (let* ((m (make-module))
+           (invoked 0))
+      (module-observe-weak m (lambda (mod)
+                               (if (eq? mod m)
+                                   (set! invoked (+ invoked 1)))))
+      (module-define! m 'something 2)
+      (module-define! m 'something-else 1)
+      (= invoked 2)))
+
+  (pass-if "all weak observers invoked"
+    (let* ((m (make-module))
+           (observer-count 500)
+           (observer-ids (let loop ((i observer-count)
+                                    (ids '()))
+                           (if (= i 0)
+                               ids
+                               (loop (- i 1) (cons (make-module) ids)))))
+           (observers-invoked (make-hash-table observer-count)))
+
+      ;; register weak observers
+      (for-each (lambda (id)
+                  (module-observe-weak m id
+                                       (lambda (m)
+                                         (hashq-set! observers-invoked
+                                                     id #t))))
+                observer-ids)
+
+      ;; invoke them
+      (module-call-observers m)
+
+      ;; make sure all of them were invoked
+      (->bool (every (lambda (id)
+                       (hashq-ref observers-invoked id))
+                     observer-ids))))
+
+  (pass-if "imported bindings updated"
+    (let ((m (make-module))
+          (imported (make-module)))
+      ;; Beautify them, notably adding them a public interface.
+      (beautify-user-module! m)
+      (beautify-user-module! imported)
+
+      (module-use! m (module-public-interface imported))
+      (module-define! imported 'imported-binding #t)
+
+      ;; At this point, `imported-binding' is local to IMPORTED.
+      (and (not (module-variable m 'imported-binding))
+           (begin
+             ;; Export `imported-binding' from IMPORTED.
+             (module-export! imported '(imported-binding))
+
+             ;; Make sure it is now visible from M.
+             (module-ref m 'imported-binding))))))
+
+
+\f
+;;;
+;;; Duplicate bindings handling.
+;;;
+
+(with-test-prefix "duplicate bindings"
+
+  (pass-if "simple duplicate handler"
+    ;; Import the same binding twice.
+    (let* ((m (make-module))
+           (import1 (make-module))
+           (import2 (make-module))
+           (handler-invoked? #f)
+           (handler (lambda (module name int1 val1 int2 val2 var val)
+                      (set! handler-invoked? #t)
+                      ;; Keep the first binding.
+                      (or var (module-local-variable int1 name)))))
+
+      (set-module-duplicates-handlers! m (list handler))
+      (module-define! m 'something 'something)
+      (module-define! import1 'imported 'imported-1)
+      (module-define! import2 'imported 'imported-2)
+      (module-use! m import1)
+      (module-use! m import2)
+      (and handler-invoked?
+           (eq? (module-ref m 'imported) 'imported-1)))))
+
+\f
+;;;
+;;; Lazy binder.
+;;;
+
+(with-test-prefix "lazy binder"
+
+  (pass-if "not invoked"
+    (let ((m (make-module))
+          (invoked? #f))
+      (module-define! m 'something 2)
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (and (module-ref m 'something)
+           (not invoked?))))
+
+  (pass-if "not invoked (module-add!)"
+    (let ((m (make-module))
+          (invoked? #f))
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (module-add! m 'something (make-variable 2))
+      (and (module-ref m 'something)
+           (not invoked?))))
+
+  (pass-if "invoked (module-ref)"
+    (let ((m (make-module))
+          (invoked? #f))
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (false-if-exception (module-ref m 'something))
+      invoked?))
+
+  (pass-if "invoked (module-define!)"
+    (let ((m (make-module))
+          (invoked? #f))
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (module-define! m 'something 2)
+      (and invoked?
+           (eq? (module-ref m 'something) 2))))
+
+  (pass-if "honored (ref)"
+    (let ((m (make-module))
+          (invoked? #f)
+          (value (cons 'x 'y)))
+      (set-module-binder! m
+                          (lambda (mod sym define?)
+                            (set! invoked? #t)
+                            (cond ((not (eq? m mod))
+                                   (error "invalid module" mod))
+                                  (define?
+                                   (error "DEFINE? shouldn't be set"))
+                                  (else
+                                   (make-variable value)))))
+      (and (eq? (module-ref m 'something) value)
+           invoked?))))
+
+
+\f
+;;;
+;;; Higher-level features.
+;;;
 
 (with-test-prefix "autoload"
 
+  (pass-if "module-autoload!"
+     (let ((m (make-module)))
+       (module-autoload! m '(ice-9 q) '(make-q))
+       (not (not (module-ref m 'make-q)))))
+
   (pass-if "autoloaded"
      (catch #t
        (lambda ()




[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-17 15:15 Evolution & optimization of the module system Ludovic Courtès
@ 2007-02-18 23:32 ` Kevin Ryde
  2007-02-19  9:24   ` Ludovic Courtès
  0 siblings, 1 reply; 18+ messages in thread
From: Kevin Ryde @ 2007-02-18 23:32 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guile-devel

ludo@chbouib.org (Ludovic Courtès) writes:
>
> (1) has to do mainly with `module-use!' vs. `module-use-interfaces!' (as
> was discussed recently).  Namely the fact that duplicate processing is
> not always performed, depending on whether one uses `module-use!' or
> some other means to use a module.

There's nothing broken though is there, it's just a trap for the
unwary (like me for instance, wrestling with use-srfis)?

> There's still more to do to achieve (2) (notably actual documentation
> ;-))

I've put that off, because a lot looks like internals, and I'd
wondered if r6rs might offer some of its own "introspection" stuff.

> The patch solves this issue by making
> duplicate processing inescapable.  Likewise, variable lookup currently
> has two implementations (which have the same behavior, though): the C
> `module_variable ()' and the Scheme `module-variable'.  The patch leaves
> only one implementation of that.

Moving stuff into C is a good thing.  You can propose that separately
if you like, it should be able to go straight in.  (And could be a
candidate for the 1.8 branch if the performance help is noticable.)

> Although duplicates should be the exception rather than the rule[*],
> duplicate processing is pretty costly: the current `process-duplicates'
> is roughly O(N*USES),

USES is supposed to be smallish of course though.

> Likewise,
> variable lookup (e.g., in `module_variable ()') is O(USES).  I believe
> that both may have a sensible impact on startup time.

Something definitely slows down startup over 1.6.  I'd guessed it was
strings, but I failed miserably at making either gprof or
functioncheck give some call counts to prove or disprove that.

> The patch addresses this by changing the data structures used by
> modules: instead of a list of used modules, it uses a second "obarray",
> called the "import obarray", that maps symbols to the modules providing
> them.

That would increase the memory used by a module though, would it?  Big
modules imported into lots of other places would have their binding
list much copied would they?  (I'm thinking for instance of gtk and
gnome, and thinking purely selfishly since I import gtk and/or gdk
into a bunch of my modules.)

> This has several implications.  First, duplicate processing occurs the
> same way for dynamically added bindings than for "statically imported"
> bindings.  Second, it makes load-time-dependent duplicate policies such
> as `last' and `first' irrelevant (since they are inherently
> non-deterministic).

Last and first still sound pretty sensible.

> Third, it makes dynamic addition of bindings relatively costly.

Depends how often that happens I suppose.  There's no actual
documented way to do it is there? :-)  Maybe some tomfoolery with
macros and eval ...

> (2) the
> SMOB classes are added to a separate module called `(oop goops
> smob-classes)'.  Since only `(oop goops)' uses it, it is the only one
> that needs to re-process duplicates as new SMOB classes are added.

Sounds ok in principle.

> From the measurements I've made, the new version is
> around 40 times faster than the other one.

Is that in part due to moving the variable lookup to C?

> So the question is: is the `beautify-user-module!' overhead compensated
> by the variable lookup and duplicate processing gains?

I'd be inclined to say probably not, but that maybe there's another
way.

Duplicates is trying to find the intersection between one set of
symbols (from one module) and some reasonably smallish number N of
other sets (from other modules) is it?  I wonder if there's some way
to find that more efficiently.

I guess the `warn' in the default duplicates handling makes it
necessary to find all the duplicates.  Nice enough feature, but
without it there'd be no need to check any duplicates at all, or only
check against the few `#:replace' lists.

Maybe the worst afflicted programs should be advised to turn it off,
or even turn it off globally when confident there's no accidental
clashes.  And for a start I guess we don't need any duplicates work in
the core, at least up until reaching the `--use-srfi' stage of
startup, if that isn't already the case.


> +      (define %default-import-size
> +        ;; This should be the size of the pre-module obarray.
> +        500)

Which also ends up being a minimum size of course ...

> +/* Copy the given alist, i.e., duplicate all its pairs recursively.  */
> +static inline SCM
> +alist_copy (SCM alist)

If you end up using this you could move scm_srfi1_alist_copy from
srfi/srfi-1.c into the core (leaving behind a #define and a
re-export).

> -/*
> -  TODO: should export this function? --hwn.
> - */
> -static SCM
> -scm_export (SCM module, SCM namelist)
> +SCM
> +scm_module_export (SCM module, SCM namelist)

That could be an "scm_i_" (for now at least) if it's not documented.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-18 23:32 ` Kevin Ryde
@ 2007-02-19  9:24   ` Ludovic Courtès
  2007-02-21 22:21     ` Kevin Ryde
  0 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2007-02-19  9:24 UTC (permalink / raw)
  To: guile-devel

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> ludo@chbouib.org (Ludovic Courtès) writes:
>>
>> (1) has to do mainly with `module-use!' vs. `module-use-interfaces!' (as
>> was discussed recently).  Namely the fact that duplicate processing is
>> not always performed, depending on whether one uses `module-use!' or
>> some other means to use a module.
>
> There's nothing broken though is there, it's just a trap for the
> unwary (like me for instance, wrestling with use-srfis)?

Indeed, but it's easy to get trapped.  ;-)

> I've put that off, because a lot looks like internals, and I'd
> wondered if r6rs might offer some of its own "introspection" stuff.

AFAICS, R6RS does not define any introspection or run-time module
facilities akin to `module-define!', `module-ref', etc.  It only
provides the `library' form.  So we may want to document our own
run-time module API since it's actually been used for some time,
including outside of Guile core.

(That said, R6RS module systems introduces a clean phase separation that
we may want to implement, but that's another story.)

>> Although duplicates should be the exception rather than the rule[*],
>> duplicate processing is pretty costly: the current `process-duplicates'
>> is roughly O(N*USES),
>
> USES is supposed to be smallish of course though.

Actually, `process-duplicates' is O(N*USES) _for each module used_.  So
the overall duplicate processing is really O(N*USES^2).  With the
patched version, the whole process is O(N*USES).  That can make quite a
difference when USES > 1.

>> Likewise,
>> variable lookup (e.g., in `module_variable ()') is O(USES).  I believe
>> that both may have a sensible impact on startup time.
>
> Something definitely slows down startup over 1.6.  I'd guessed it was
> strings, but I failed miserably at making either gprof or
> functioncheck give some call counts to prove or disprove that.

I think the module system hasn't changed much since 1.6.

>> The patch addresses this by changing the data structures used by
>> modules: instead of a list of used modules, it uses a second "obarray",
>> called the "import obarray", that maps symbols to the modules providing
>> them.
>
> That would increase the memory used by a module though, would it?  Big
> modules imported into lots of other places would have their binding
> list much copied would they?  (I'm thinking for instance of gtk and
> gnome, and thinking purely selfishly since I import gtk and/or gdk
> into a bunch of my modules.)

Right, it increases the size of individual module objects.  I haven't
made any measurements but I'm not sure whether it should be a concern,
given that the number of modules is not supposed to be too high (i.e.,
at most a few hundreds).  Any idea of an estimate of the memory occupied
by a (balanced) hash table given its number of elements?

OTOH, if we were to use the same data structure for all the phases of a
module (when we support phase separation), the impact would be more
noticeable.

>> This has several implications.  First, duplicate processing occurs the
>> same way for dynamically added bindings than for "statically imported"
>> bindings.  Second, it makes load-time-dependent duplicate policies such
>> as `last' and `first' irrelevant (since they are inherently
>> non-deterministic).
>
> Last and first still sound pretty sensible.

Yes, but they behave in unpredictable ways in the presence of
dynamically added bindings and dynamic duplicate processing (especially
as they interact with memoization).

>> Third, it makes dynamic addition of bindings relatively costly.
>
> Depends how often that happens I suppose.  There's no actual
> documented way to do it is there? :-)  Maybe some tomfoolery with
> macros and eval ...

I was referring to `module-define!' and similar (which, although not
documented, is actually used...).

>> From the measurements I've made, the new version is
>> around 40 times faster than the other one.
>
> Is that in part due to moving the variable lookup to C?

No, I was referring to `module-use-interfaces!' which does not involve
variable lookup (not using `module-variable').  It uses the now
C-implemented `module-import-interface' but the most important point is
the different algorithm.  So it's really a comparison of the O(N*USES^2)
vs. O(N*USES) discussed earlier.

>> So the question is: is the `beautify-user-module!' overhead compensated
>> by the variable lookup and duplicate processing gains?
>
> I'd be inclined to say probably not, but that maybe there's another
> way.

The measurements I made tend to tell the contrary, but further
measurements are certainly needed.

> Duplicates is trying to find the intersection between one set of
> symbols (from one module) and some reasonably smallish number N of
> other sets (from other modules) is it?  I wonder if there's some way
> to find that more efficiently.

Maybe, I dunno (at first sight, `lset-intersection' doesn't seem to be
particularly smart, though).

> I guess the `warn' in the default duplicates handling makes it
> necessary to find all the duplicates.  Nice enough feature, but
> without it there'd be no need to check any duplicates at all, or only
> check against the few `#:replace' lists.

Duplicate checking is very useful I think.  User-configurable duplicate
handling policies as available are maybe too flexible and too costly.
But I'm not sure we could drop their support in the next major release,
could we?

The patch is trying to be conservative by not removing any feature and
being as API-compatible as possible.  But if we decide that we can drop
duplicate handling policies, then we can probably envision different
solutions (for instance, enforcing a single policy that raises an error
when duplicate bindings are encountered).

> Maybe the worst afflicted programs should be advised to turn it off,
> or even turn it off globally when confident there's no accidental
> clashes.  And for a start I guess we don't need any duplicates work in
> the core, at least up until reaching the `--use-srfi' stage of
> startup, if that isn't already the case.

Depends on what you mean here.  Modules distributed with core Guile are
not special-cased (and shouldn't be, IMO).

>> +      (define %default-import-size
>> +        ;; This should be the size of the pre-module obarray.
>> +        500)
>
> Which also ends up being a minimum size of course ...

Yes, it should really be 2000 which is an upper bound of the number of
bindings in `the-scm-module'.

>> +/* Copy the given alist, i.e., duplicate all its pairs recursively.  */
>> +static inline SCM
>> +alist_copy (SCM alist)
>
> If you end up using this you could move scm_srfi1_alist_copy from
> srfi/srfi-1.c into the core (leaving behind a #define and a
> re-export).

Right.  OTOH, I like to have it in-line and non-type-checking.

>> -/*
>> -  TODO: should export this function? --hwn.
>> - */
>> -static SCM
>> -scm_export (SCM module, SCM namelist)
>> +SCM
>> +scm_module_export (SCM module, SCM namelist)
>
> That could be an "scm_i_" (for now at least) if it's not documented.

That was meant to be documented eventually.

Thanks!

Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-19  9:24   ` Ludovic Courtès
@ 2007-02-21 22:21     ` Kevin Ryde
  2007-02-22  9:20       ` Ludovic Courtès
  0 siblings, 1 reply; 18+ messages in thread
From: Kevin Ryde @ 2007-02-21 22:21 UTC (permalink / raw)
  To: guile-devel

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> Actually, `process-duplicates' is O(N*USES) _for each module used_.  So
> the overall duplicate processing is really O(N*USES^2).  With the
> patched version, the whole process is O(N*USES).  That can make quite a
> difference when USES > 1.

It should be ok, it's only hash table lookups, which are fast.  And N
is normally pretty modest too.

> Right, it increases the size of individual module objects.  I haven't
> made any measurements but I'm not sure whether it should be a concern,
> given that the number of modules is not supposed to be too high (i.e.,
> at most a few hundreds).  Any idea of an estimate of the memory occupied
> by a (balanced) hash table given its number of elements?

Copying the table of 2000 core bindings into every module doesn't
sound good, not if it's only for once-off duplicates checking.  If you
want you can check the existing innermost loops are good.  In
process-duplicates var1 and var2 are almost always different (one of
them #f usually), so getting that down to C with some sort of
"hashq-intersection" or "hashq-for-each-intersection" would help a
lot.  I'd predict throwing a little C at bottlenecks like that will be
enough.

Another possibility would be to defer duplicates checking until the
end of a define-module or use-modules form (or even until the end of
the file), if mutual cross-checks can be done faster en-block, if you
know what I mean.  It could use a temporary combined hash if that
helped (perhaps sharing bucket cells to save gc work).  The particular
"module-define!" you struck should obviously be only about USES many
hash lookups (ie. about a dozen typically), most of the time, if
that's not already the case.

> Depends on what you mean here.  Modules distributed with core Guile are
> not special-cased (and shouldn't be, IMO).

They're special in that we know there's no clashes between them.
process-duplicates should ignore any ice-9 vs ice-9, if that doesn't
happen already.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-21 22:21     ` Kevin Ryde
@ 2007-02-22  9:20       ` Ludovic Courtès
  2007-02-22 22:23         ` Kevin Ryde
  0 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2007-02-22  9:20 UTC (permalink / raw)
  To: guile-devel

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>>
>> Actually, `process-duplicates' is O(N*USES) _for each module used_.  So
>> the overall duplicate processing is really O(N*USES^2).  With the
>> patched version, the whole process is O(N*USES).  That can make quite a
>> difference when USES > 1.
>
> It should be ok, it's only hash table lookups, which are fast.  And N
> is normally pretty modest too.

I don't think so.  Remember: `module-import-interface' (used by
`process-duplicates'), in the current Guile, is _not_ a hash table
lookup, it's a traversal of the module's use list.  The patched version
is always USES times as fast as the current implementation.  So even
with USES <= 5, it does make a difference.

The measurements in the `module-duplicates.scm' file I posted choose
USES = 10000 by default, which is arguably unrealistic.  However,
timings are way too small when choosing USES < 1000.

> Copying the table of 2000 core bindings into every module doesn't
> sound good, not if it's only for once-off duplicates checking.

I agree that it sounds a bit overkill at first sight.  ;-)  However, it
benefits to both duplicate checking and variable lookup.

> If you
> want you can check the existing innermost loops are good.  In
> process-duplicates var1 and var2 are almost always different (one of
> them #f usually), so getting that down to C with some sort of
> "hashq-intersection" or "hashq-for-each-intersection" would help a
> lot.  I'd predict throwing a little C at bottlenecks like that will be
> enough.

Yes, that would probably help a little.  However, I was trying to have
an algorithmic approach to the issue, being convinced that the most
important gains can be obtained this way.  So I'd like to stick to an
algorithmic evaluation for now and only then consider
"micro-optimizations".

> Another possibility would be to defer duplicates checking until the
> end of a define-module or use-modules form (or even until the end of
> the file), if mutual cross-checks can be done faster en-block, if you
> know what I mean.

That's already what happens: When `process-define-module' finishes, it
invokes `module-use-interfaces!', passing it all the imported modules.
If a `use-modules' form is used later in the source file, the a new
duplicate processing stage occurs.  Currently, it doesn't make any
difference performance-wise, though, since `process-duplicates' only
handles one imported module at a time (and I can't think of any other
way to do it).

> It could use a temporary combined hash if that
> helped (perhaps sharing bucket cells to save gc work).

What do you mean by "combined hash"?

> The particular
> "module-define!" you struck should obviously be only about USES many
> hash lookups (ie. about a dozen typically), most of the time, if
> that's not already the case.

Theoretically, yes.  However, that can only be the case if observers are
passed precise information about what changed in the observed module,
such a description of the operation that led to the change (e.g.,
`define') and a list of affected bindings.  Currently, observers are
just notified that "something" changed, thus they have to run
`process-duplicates' in its entirety.

Anyway, I'm not sure we should worry too much about "`module-define!' at
run-time".

> They're special in that we know there's no clashes between them.
> process-duplicates should ignore any ice-9 vs ice-9, if that doesn't
> happen already.

I'd prefer to first optimize the general case, and then only resort to
such special-casing optimizations when all other recipes failed.
Special-casing makes code more complex and harder to work with IMO.

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-22  9:20       ` Ludovic Courtès
@ 2007-02-22 22:23         ` Kevin Ryde
  2007-02-23 13:15           ` Ludovic Courtès
  0 siblings, 1 reply; 18+ messages in thread
From: Kevin Ryde @ 2007-02-22 22:23 UTC (permalink / raw)
  To: guile-devel

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> The measurements in the `module-duplicates.scm' file I posted choose
> USES = 10000 by default, which is arguably unrealistic.

Was that 10000 imported modules?  That's well outside the realm of
reason! :)  Normally there'll be perhaps up to 20 imports, so there
should be no call to change unless that sort of quantity is hurting
badly (which I would say I've never noticed it doing).


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-22 22:23         ` Kevin Ryde
@ 2007-02-23 13:15           ` Ludovic Courtès
  2007-02-25 23:37             ` Kevin Ryde
  0 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2007-02-23 13:15 UTC (permalink / raw)
  To: guile-devel

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>>
>> The measurements in the `module-duplicates.scm' file I posted choose
>> USES = 10000 by default, which is arguably unrealistic.
>
> Was that 10000 imported modules?  That's well outside the realm of
> reason! :)

Right.  :-)

> Normally there'll be perhaps up to 20 imports, so there
> should be no call to change unless that sort of quantity is hurting
> badly (which I would say I've never noticed it doing).

Well it _does_ hurt, even with real-life numbers of imports, as the
experiments I made tend to show (I'm talking about the measurements made
on real applications, not the synthetic evaluation in
`module-duplicates.scm').  I really encourage everyone to apply the
patch and make timing measurements on their own applications, so that we
get better insight about the benefits of the changes.

Alternatively, we could start thinking about the module system "from
scratch".  From a performance viewpoint, the question is: how can we
provide the fastest variable lookup and duplicate binding detection,
i.e., using what data structures and algorithms?

Hopefully it is now clear that improvements can be made over the current
implementation in these respects.  Then, how?


I'm not sure other interpreters provide such sophisticated module
systems.  SLIB's `require' is much simpler for instance, and SCSH (or is
it Scheme48?) doesn't seem to address duplicate binding detection
according to the "Module Warning" note in Section 11.1.3 of the manual
for version 0.6.7.

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-23 13:15           ` Ludovic Courtès
@ 2007-02-25 23:37             ` Kevin Ryde
  2007-02-26 21:15               ` Ludovic Courtès
                                 ` (2 more replies)
  0 siblings, 3 replies; 18+ messages in thread
From: Kevin Ryde @ 2007-02-25 23:37 UTC (permalink / raw)
  To: guile-devel

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> Well it _does_ hurt, even with real-life numbers of imports, as the
> experiments I made tend to show

If that's true you'll have to start from the beginning again,
everyone's eyes glaze over at "1000 modules".

> From a performance viewpoint, the question is: how can we
> provide the fastest variable lookup and duplicate binding detection,
> i.e., using what data structures and algorithms?

There's no need to think too hard about the data until the innermost
code dealing with them is in C.

I guess the general problem is sets of names to be combined and looked
up with certain precedence.  I can't see anything much to help that
without using quite a bit of extra memory (which of course is bad for
gc, and bad for the system generally because it's unshared).

One possibility for duplicates would be lazy checking, only check for
a clash when actually using a symbol.  That's sort of the prolog
theory: don't worry now about what might never come up.  I suspect the
total work would end up greater though.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-25 23:37             ` Kevin Ryde
@ 2007-02-26 21:15               ` Ludovic Courtès
  2007-02-26 22:46                 ` Kevin Ryde
  2007-04-08 23:06               ` Ludovic Courtès
  2007-04-08 23:24               ` Ludovic Courtès
  2 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2007-02-26 21:15 UTC (permalink / raw)
  To: guile-devel

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> If that's true you'll have to start from the beginning again,
> everyone's eyes glaze over at "1000 modules".

Quoting the original message in this thread:

  An application of mine [1], although it modifies `the-scm-module' at
  run-time, requiring 40 modules to re-process duplicates, has its
  execution time reduced by 8% (on a run that loads around 100 modules).
  The whole test suite runs about 10% faster with the modified version
  (although it has a larger `modules.test').  So it seems to be beneficial
  performance-wise.  I'd be happy if people could try it out with other
  applications (e.g., Lilypond ;-)) and measure the difference it makes.

Note that the two measurements are on whole application execution time
(none of them is long-running, though).  So 8%-10% is pretty good given
that the changes are expected to be beneficial only at initialization
time, i.e., before all duplicates have been processed and all variables
have been memoized.

So, once again, if people could make similar measurements with other
applications, that'd be really great.  :-)

>> From a performance viewpoint, the question is: how can we
>> provide the fastest variable lookup and duplicate binding detection,
>> i.e., using what data structures and algorithms?
>
> There's no need to think too hard about the data until the innermost
> code dealing with them is in C.

If I understood correctly, I think I disagree.  Writing in C or assembly
doesn't free from choosing appropriate algorithms.  An algorithm that is
not scalable is not scalable, whether it is implemented in C or not.

> I guess the general problem is sets of names to be combined and looked
> up with certain precedence.  I can't see anything much to help that
> without using quite a bit of extra memory (which of course is bad for
> gc, and bad for the system generally because it's unshared).

Yes, there may be a space-time tradeoff.  Clearly, my patch requires
more (heap-allocated) memory.

> One possibility for duplicates would be lazy checking, only check for
> a clash when actually using a symbol.  That's sort of the prolog
> theory: don't worry now about what might never come up.  I suspect the
> total work would end up greater though.

So we'd perform duplicate checking as variables are looked up?
Interesting idea.  Then we'd completely remove `process-duplicates' and
would have an O(USES) variable lookup.

However, it may be quite R6RS-unfriendly since R6RS requires duplicates
to be detected as errors, i.e., before code is actually run (Section 6.1
of R5.92RS).

Anyway, maybe we should give it a try and compare both approaches?

Thanks,
Ludo'.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-26 21:15               ` Ludovic Courtès
@ 2007-02-26 22:46                 ` Kevin Ryde
  2007-02-27  8:21                   ` Ludovic Courtès
  0 siblings, 1 reply; 18+ messages in thread
From: Kevin Ryde @ 2007-02-26 22:46 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guile-devel

ludo@chbouib.org (Ludovic Courtès) writes:
>
> Writing in C or assembly doesn't free from choosing appropriate
> algorithms.

It's rather unfair to the data structure to say it's no good when
there's likely to be an easy speedup between perhaps 2x and 5x.  In
principle all core primitives should be implemented in C; it loads
faster, runs faster, and shares memory between processes.  Of course
scheme is much friendlier to write, and there's no burning need to
squeeze out every last drop from things that are adequate as they
stand.  But if there's an issue of performance then some C is the
natural first step (or natural first to be excluded).


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-26 22:46                 ` Kevin Ryde
@ 2007-02-27  8:21                   ` Ludovic Courtès
  0 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2007-02-27  8:21 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guile-devel

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> It's rather unfair to the data structure to say it's no good when
> there's likely to be an easy speedup between perhaps 2x and 5x.

Can you be more specific?

> In principle all core primitives should be implemented in C;

"Developers are the compiler".  :-)

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-25 23:37             ` Kevin Ryde
  2007-02-26 21:15               ` Ludovic Courtès
@ 2007-04-08 23:06               ` Ludovic Courtès
  2007-04-08 23:25                 ` Ludovic Courtès
  2007-04-08 23:24               ` Ludovic Courtès
  2 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2007-04-08 23:06 UTC (permalink / raw)
  To: guile-devel

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> One possibility for duplicates would be lazy checking, only check for
> a clash when actually using a symbol.  That's sort of the prolog
> theory: don't worry now about what might never come up.  I suspect the
> total work would end up greater though.

Attached is a patch that implements lazy duplicate checking.  Thus,
`process-duplicates' is gone and `module-variable' plays its role when a
variable is looked up for the first time.  Subsequent lookups result in
a "cache hit", i.e., the result is taken from the "import obarray" which
is used as a cache.

The code is simpler and obviously less memory-hungry than my previous
attempts.  The lazy approach is not very R6RS-friendly, though (see my
earlier post on this topic).

I measured around 20% speedups in "pure startup time".  The measurements
consist in running a dozen of times a program that just does a few
`use-module's and/or `autoload's and measuring the total user execution
time.  Example scripts are available there:

  http://www.laas.fr/~lcourtes/software/guile/startup.scm
  http://www.laas.fr/~lcourtes/software/guile/startup-autoload.scm

These measurements do not account for the overhead introduced in the
variable lookup process, so measurements with actual programs were
needed.  



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-02-25 23:37             ` Kevin Ryde
  2007-02-26 21:15               ` Ludovic Courtès
  2007-04-08 23:06               ` Ludovic Courtès
@ 2007-04-08 23:24               ` Ludovic Courtès
  2007-04-30  8:39                 ` Ludovic Courtès
  2 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2007-04-08 23:24 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 1660 bytes --]

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> One possibility for duplicates would be lazy checking, only check for
> a clash when actually using a symbol.  That's sort of the prolog
> theory: don't worry now about what might never come up.  I suspect the
> total work would end up greater though.

Attached is a patch that implements lazy duplicate checking.
`process-duplicates' is gone and `module-variable' plays its role when
an imported variable is looked up for the first time.  Subsequent
lookups for the same variable result in a "cache hit", i.e., the result
is fetched directly from the "import obarray".

The code is simpler and obviously less memory-hungry than my previous
attempt.  This lazy approach is not very R6RS-friendly, though (see my
earlier post on this topic).

I measured around 20% speedups in "pure startup time".  The measurements
consist in running a dozen of times a program that just does a few
`use-module's and/or `autoload's and measuring the total user execution
time.  Example programs are available there:

  http://www.laas.fr/~lcourtes/software/guile/startup.scm
  http://www.laas.fr/~lcourtes/software/guile/startup-autoload.scm

These measurements do not account for the overhead introduced in the
variable lookup process, so measurements with actual programs were
needed.  The test suite, for instance, runs 30% faster.  Other
applications have more moderate improvements.

It is worth noting that the calls to `literal_p ()' in `eval.c' incur
non-negligible overhead since they usually fail, which means that they
have the worst-case execution time for variable lookup.

This is it.  Comments?

Thanks,
Ludovic.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Lazy duplicate binding checks --]
[-- Type: text/x-patch, Size: 36069 bytes --]

--- orig/ice-9/boot-9.scm
+++ mod/ice-9/boot-9.scm
@@ -1100,8 +1100,6 @@
 ;;;
 ;;; - duplicates-handlers
 ;;;
-;;; - duplicates-interface
-;;;
 ;;; - observers
 ;;;
 ;;; - weak-observers
@@ -1173,8 +1171,10 @@
 (define module-type
   (make-record-type 'module
 		    '(obarray uses binder eval-closure transformer name kind
-		      duplicates-handlers duplicates-interface
-		      observers weak-observers observer-id)
+		      duplicates-handlers
+                      duplicates-interface ;; FIXME: to be removed
+		      observers weak-observers observer-id
+		      import-obarray)
 		    %print-module))
 
 ;; make-module &opt size uses binder
@@ -1190,6 +1190,10 @@
 	    (list-ref args index)
 	    default))
 
+      (define %default-import-size
+        ;; This should be the size of the pre-module obarray.
+        500)
+
       (if (> (length args) 3)
 	  (error "Too many args to make-module." args))
 
@@ -1209,8 +1213,9 @@
 	(let ((module (module-constructor (make-hash-table size)
 					  uses binder #f #f #f #f #f #f
 					  '()
-					  (make-weak-value-hash-table 31)
-					  0)))
+					  (make-weak-key-hash-table 31)
+					  0
+					  (make-hash-table %default-import-size))))
 
 	  ;; We can't pass this as an argument to module-constructor,
 	  ;; because we need it to close over a pointer to the module
@@ -1240,10 +1245,6 @@
   (record-accessor module-type 'duplicates-handlers))
 (define set-module-duplicates-handlers!
   (record-modifier module-type 'duplicates-handlers))
-(define module-duplicates-interface
-  (record-accessor module-type 'duplicates-interface))
-(define set-module-duplicates-interface!
-  (record-modifier module-type 'duplicates-interface))
 (define module-observers (record-accessor module-type 'observers))
 (define set-module-observers! (record-modifier module-type 'observers))
 (define module-weak-observers (record-accessor module-type 'weak-observers))
@@ -1251,6 +1252,8 @@
 (define set-module-observer-id! (record-modifier module-type 'observer-id))
 (define module? (record-predicate module-type))
 
+(define module-import-obarray (record-accessor module-type 'import-obarray))
+
 (define set-module-eval-closure!
   (let ((setter (record-modifier module-type 'eval-closure)))
     (lambda (module closure)
@@ -1269,11 +1272,10 @@
   (set-module-observers! module (cons proc (module-observers module)))
   (cons module proc))
 
-(define (module-observe-weak module proc)
-  (let ((id (module-observer-id module)))
-    (hash-set! (module-weak-observers module) id proc)
-    (set-module-observer-id! module (+ 1 id))
-    (cons module id)))
+(define (module-observe-weak module observer-id . proc)
+  (let ((id (if (null? proc) (gensym) observer-id))
+        (proc (if (null? proc) observer-id (car proc))))
+    (hashq-set! (module-weak-observers module) observer-id proc)))
 
 (define (module-unobserve token)
   (let ((module (car token))
@@ -1311,7 +1313,11 @@
 
 (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)))
+
+  ;; We assume that weak observers don't (un)register themselves as they are
+  ;; called since this would preclude proper iteration over the hash table
+  ;; elements.
+  (hash-for-each (lambda (id proc) (proc m)) (module-weak-observers m)))
 
 \f
 
@@ -1435,26 +1441,8 @@
 ;;;
 ;;; If the symbol is not found at all, return #f.
 ;;;
-(define (module-local-variable m v)
-;  (caddr
-;   (list m v
-	 (let ((b (module-obarray-ref (module-obarray m) v)))
-	   (or (and (variable? b) b)
-	       (and (module-binder m)
-		    ((module-binder m) m v #f)))))
-;))
-
-;; module-variable module symbol
-;;
-;; like module-local-variable, except search the uses in the
-;; case V is not found in M.
-;;
-;; NOTE: This function is superseded with C code (see modules.c)
-;;;      when using the standard eval closure.
-;;
-(define (module-variable m v)
-  (module-search module-local-variable m v))
-
+;;; (This is now written in C, see `modules.c'.)
+;;;
 
 ;;; {Mapping modules x symbols --> bindings}
 ;;;
@@ -1515,19 +1503,10 @@
 	       (module-modified m)
 	       b)))
 
-      ;; No local variable yet, so we need to create a new one.  That
-      ;; new variable is initialized with the old imported value of V,
-      ;; if there is one.
-      (let ((imported-var (module-variable m v))
-	    (local-var (or (and (module-binder m)
-				((module-binder m) m v #t))
-			   (begin
-			     (let ((answer (make-undefined-variable)))
-			       (module-add! m v answer)
-			       answer)))))
-	(if (and imported-var (not (variable-bound? local-var)))
-	    (variable-set! local-var (variable-ref imported-var)))
-	local-var)))
+      ;; Create a new local variable.
+      (let ((local-var (make-undefined-variable)))
+        (module-add! m v local-var)
+        local-var)))
 
 ;; module-ensure-local-variable! module symbol
 ;;
@@ -1696,46 +1675,29 @@
 ;; Add INTERFACE to the list of interfaces used by MODULE.
 ;;
 (define (module-use! module interface)
-  (set-module-uses! module
-		    (cons interface
-			  (filter (lambda (m)
-				    (not (equal? (module-name m)
-						 (module-name interface))))
-				  (module-uses module))))
-  (module-modified module))
+  (if (not (eq? module interface))
+      (begin
+        ;; Newly used modules must be appended rather than consed, so that
+        ;; `module-variable' traverses the use list starting from the first
+        ;; used module.
+        (set-module-uses! module
+                          (append (filter (lambda (m)
+                                            (not
+                                             (equal? (module-name m)
+                                                     (module-name interface))))
+                                          (module-uses module))
+                                  (list interface)))
+
+        (module-modified module))))
 
 ;; MODULE-USE-INTERFACES! module interfaces
 ;;
 ;; Same as MODULE-USE! but add multiple interfaces and check for duplicates
 ;;
 (define (module-use-interfaces! module interfaces)
-  (let* ((duplicates-handlers? (or (module-duplicates-handlers module)
-				   (default-duplicate-binding-procedures)))
-	 (uses (module-uses module)))
-    ;; remove duplicates-interface
-    (set! uses (delq! (module-duplicates-interface module) uses))
-    ;; remove interfaces to be added
-    (for-each (lambda (interface)
-		(set! uses
-		      (filter (lambda (m)
-				(not (equal? (module-name m)
-					     (module-name interface))))
-			      uses)))
-	      interfaces)
-    ;; add interfaces to use list
-    (set-module-uses! module uses)
-    (for-each (lambda (interface)
-		(and duplicates-handlers?
-		     ;; perform duplicate checking
-		     (process-duplicates module interface))
-		(set! uses (cons interface uses))
-		(set-module-uses! module uses))
-	      interfaces)
-    ;; add duplicates interface
-    (if (module-duplicates-interface module)
-	(set-module-uses! module
-			  (cons (module-duplicates-interface module) uses)))
-    (module-modified module)))
+  (set-module-uses! module
+                    (append (module-uses module) interfaces))
+  (module-modified module))
 
 \f
 
@@ -1861,8 +1823,8 @@
 	  (set-module-public-interface! module interface))))
   (if (and (not (memq the-scm-module (module-uses module)))
 	   (not (eq? module the-root-module)))
-      (set-module-uses! module
-			(append (module-uses module) (list the-scm-module)))))
+      ;; Import the default set of bindings (from the SCM module) in MODULE.
+      (module-use! module the-scm-module)))
 
 ;; NOTE: This binding is used in libguile/modules.c.
 ;;
@@ -1893,6 +1855,7 @@
 (define process-define-module #f)
 (define process-use-modules #f)
 (define module-export! #f)
+(define default-duplicate-binding-procedures #f)
 
 ;; This boots the module system.  All bindings needed by modules.c
 ;; must have been defined by now.
@@ -2027,7 +1990,8 @@
 	       (reversed-interfaces '())
 	       (exports '())
 	       (re-exports '())
-	       (replacements '()))
+	       (replacements '())
+               (autoloads '()))
 
       (if (null? kws)
 	  (call-with-deferred-observers
@@ -2035,7 +1999,9 @@
 	     (module-use-interfaces! module (reverse reversed-interfaces))
 	     (module-export! module exports)
 	     (module-replace! module replacements)
-	     (module-re-export! module re-exports)))
+	     (module-re-export! module re-exports)
+             (if (not (null? autoloads))
+                 (apply module-autoload! module autoloads))))
 	  (case (car kws)
 	    ((#:use-module #:use-syntax)
 	     (or (pair? (cdr kws))
@@ -2055,31 +2021,35 @@
 		     (cons interface reversed-interfaces)
 		     exports
 		     re-exports
-		     replacements)))
+		     replacements
+                     autoloads)))
 	    ((#:autoload)
 	     (or (and (pair? (cdr kws)) (pair? (cddr kws)))
 		 (unrecognized kws))
 	     (loop (cdddr kws)
-		   (cons (make-autoload-interface module
-						  (cadr kws)
-						  (caddr kws))
-			 reversed-interfaces)
+                   reversed-interfaces
 		   exports
 		   re-exports
-		   replacements))
+		   replacements
+                   (let ((name (cadr kws))
+                         (bindings (caddr kws)))
+                     (cons* name bindings autoloads))))
 	    ((#:no-backtrace)
 	     (set-system-module! module #t)
-	     (loop (cdr kws) reversed-interfaces exports re-exports replacements))
+	     (loop (cdr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
 	    ((#:pure)
 	     (purify-module! module)
-	     (loop (cdr kws) reversed-interfaces exports re-exports replacements))
+	     (loop (cdr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
 	    ((#:duplicates)
 	     (if (not (pair? (cdr kws)))
 		 (unrecognized kws))
 	     (set-module-duplicates-handlers!
 	      module
 	      (lookup-duplicates-handlers (cadr kws)))
-	     (loop (cddr kws) reversed-interfaces exports re-exports replacements))
+	     (loop (cddr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
 	    ((#:export #:export-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
@@ -2087,7 +2057,8 @@
 		   reversed-interfaces
 		   (append (cadr kws) exports)
 		   re-exports
-		   replacements))
+		   replacements
+                   autoloads))
 	    ((#:re-export #:re-export-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
@@ -2095,7 +2066,8 @@
 		   reversed-interfaces
 		   exports
 		   (append (cadr kws) re-exports)
-		   replacements))
+		   replacements
+                   autoloads))
 	    ((#:replace #:replace-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
@@ -2103,7 +2075,8 @@
 		   reversed-interfaces
 		   exports
 		   re-exports
-		   (append (cadr kws) replacements)))
+		   (append (cadr kws) replacements)
+                   autoloads))
 	    (else
 	     (unrecognized kws)))))
     (run-hook module-defined-hook module)
@@ -2132,7 +2105,23 @@
 			  (set-car! autoload i)))
 		    (module-local-variable i sym))))))
     (module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f #f
-			'() (make-weak-value-hash-table 31) 0)))
+			'() (make-weak-value-hash-table 31) 0 (make-hash-table 0))))
+
+(define (module-autoload! module . args)
+  "Have @var{module} automatically load the module named @var{name} when one
+of the symbols listed in @var{bindings} is looked up."
+  (let loop ((args args))
+    (cond ((null? args)
+           #t)
+          ((null? (cdr args))
+           (error "invalid name+binding autoload list" args))
+          (else
+           (let ((name     (car args))
+                 (bindings (cadr args)))
+             (module-use! module (make-autoload-interface module
+                                                          name bindings))
+             (loop (cddr args)))))))
+
 
 ;;; {Compiled module}
 
@@ -3133,57 +3122,6 @@
 			      (lookup-duplicates-handlers handler-names))
 			    handler-names)))
 
-(define (make-duplicates-interface)
-  (let ((m (make-module)))
-    (set-module-kind! m 'custom-interface)
-    (set-module-name! m 'duplicates)
-    m))
-
-(define (process-duplicates module interface)
-  (let* ((duplicates-handlers (or (module-duplicates-handlers module)
-				  (default-duplicate-binding-procedures)))
-	 (duplicates-interface (module-duplicates-interface module)))
-    (module-for-each
-     (lambda (name var)
-       (cond ((module-import-interface module name)
-	      =>
-	      (lambda (prev-interface)
-		(let ((var1 (module-local-variable prev-interface name))
-		      (var2 (module-local-variable interface name)))
-		  (if (not (eq? var1 var2))
-		      (begin
-			(if (not duplicates-interface)
-			    (begin
-			      (set! duplicates-interface
-				    (make-duplicates-interface))
-			      (set-module-duplicates-interface!
-			       module
-			       duplicates-interface)))
-			(let* ((var (module-local-variable duplicates-interface
-							   name))
-			       (val (and var
-					 (variable-bound? var)
-					 (variable-ref var))))
-			  (let loop ((duplicates-handlers duplicates-handlers))
-			    (cond ((null? duplicates-handlers))
-				  (((car duplicates-handlers)
-				    module
-				    name
-				    prev-interface
-				    (and (variable-bound? var1)
-					 (variable-ref var1))
-				    interface
-				    (and (variable-bound? var2)
-					 (variable-ref var2))
-				    var
-				    val)
-				   =>
-				   (lambda (var)
-				     (module-add! duplicates-interface name var)))
-				  (else
-				   (loop (cdr duplicates-handlers)))))))))))))
-     interface)))
-
 \f
 
 ;;; {`cond-expand' for SRFI-0 support.}
@@ -3398,10 +3336,7 @@
 	  '(((ice-9 threads)))
 	  '())))
     ;; load debugger on demand
-    (module-use! guile-user-module
-		 (make-autoload-interface guile-user-module
-					  '(ice-9 debugger) '(debug)))
-
+    (module-autoload! guile-user-module '(ice-9 debugger) '(debug))
 
     ;; Note: SIGFPE, SIGSEGV and SIGBUS are actually "query-only" (see
     ;; scmsigs.c scm_sigaction_for_thread), so the handlers setup here have
@@ -3475,6 +3410,7 @@
 (begin-deprecated
  (primitive-load-path "ice-9/deprecated.scm"))
 
+
 \f
 
 ;;; Place the user in the guile-user module.


--- orig/libguile/modules.c
+++ mod/libguile/modules.c
@@ -162,12 +162,8 @@
 
 static SCM module_export_x_var;
 
-
-/*
-  TODO: should export this function? --hwn.
- */
-static SCM
-scm_export (SCM module, SCM namelist)
+SCM
+scm_module_export (SCM module, SCM namelist)
 {
   return scm_call_2 (SCM_VARIABLE_REF (module_export_x_var),
 		     module, namelist);
@@ -203,7 +199,7 @@
 	  tail = SCM_CDRLOC (*tail);
 	}
       va_end (ap);
-      scm_export (scm_current_module(), names);
+      scm_module_export (scm_current_module (), names);
     }
 }
 
@@ -278,42 +274,220 @@
  * release.
  */
 
-static SCM module_make_local_var_x_var;
+/* The `module-make-local-var!' variable.  */
+static SCM module_make_local_var_x_var = SCM_UNSPECIFIED;
 
-static SCM
-module_variable (SCM module, SCM sym)
+/* The `default-duplicate-binding-procedures' variable.  */
+static SCM default_duplicate_binding_procedures_var = SCM_UNSPECIFIED;
+
+/* Return the list of default duplicate binding handlers (procedures).  */
+static inline SCM
+default_duplicate_binding_handlers (void)
+{
+  SCM get_handlers;
+
+  get_handlers = SCM_VARIABLE_REF (default_duplicate_binding_procedures_var);
+
+  return (scm_call_0 (get_handlers));
+}
+
+/* Resolve the import of SYM in MODULE, where SYM is currently provided by
+   both IFACE1 as VAR1 and IFACE2 as VAR2.  Return the variable chosen by the
+   duplicate binding handlers or `#f'.  */
+static inline SCM
+resolve_duplicate_binding (SCM module, SCM sym,
+			   SCM iface1, SCM var1,
+			   SCM iface2, SCM var2)
+{
+  SCM result = SCM_BOOL_F;
+
+  if (!scm_is_eq (var1, var2))
+    {
+      SCM val1, val2;
+      SCM handlers, h, handler_args;
+
+      val1 = SCM_VARIABLE_REF (var1);
+      val2 = SCM_VARIABLE_REF (var2);
+
+      val1 = (val1 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val1;
+      val2 = (val2 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val2;
+
+      handlers = SCM_MODULE_DUPLICATE_HANDLERS (module);
+      if (scm_is_false (handlers))
+	handlers = default_duplicate_binding_handlers ();
+
+      handler_args = scm_list_n (module, sym,
+				 iface1, val1, iface2, val2,
+				 var1, val1,
+				 SCM_UNDEFINED);
+
+      for (h = handlers;
+	   scm_is_pair (h) && scm_is_false (result);
+	   h = SCM_CDR (h))
+	{
+	  result = scm_apply (SCM_CAR (h), handler_args, SCM_EOL);
+	}
+    }
+  else
+    result = var1;
+
+  return result;
+}
+
+/* Lookup SYM as an imported variable of MODULE.  */
+static inline SCM
+module_imported_variable (SCM module, SCM sym)
+{
+#define SCM_BOUND_THING_P scm_is_true
+  register SCM var, imports;
+
+  /* Search cached imported bindings.  */
+  imports = SCM_MODULE_IMPORT_OBARRAY (module);
+  var = scm_hashq_ref (imports, sym, SCM_UNDEFINED);
+  if (SCM_BOUND_THING_P (var))
+    return var;
+
+  {
+    /* Search the use list for yet uncached imported bindings, possibly
+       resolving duplicates as needed and caching the result in the import
+       obarray.  */
+    SCM uses;
+    SCM found_var = SCM_BOOL_F, found_iface = SCM_BOOL_F;
+
+    for (uses = SCM_MODULE_USES (module);
+	 scm_is_pair (uses);
+	 uses = SCM_CDR (uses))
+      {
+	SCM iface;
+
+	iface = SCM_CAR (uses);
+	var = scm_module_variable (iface, sym);
+
+	if (SCM_BOUND_THING_P (var))
+	  {
+	    if (SCM_BOUND_THING_P (found_var))
+	      {
+		/* SYM is a duplicate binding (imported more than once) so we
+		   need to resolve it.  */
+		found_var = resolve_duplicate_binding (module, sym,
+						       found_iface, found_var,
+						       iface, var);
+		if (scm_is_eq (found_var, var))
+		  found_iface = iface;
+	      }
+	    else
+	      /* Keep track of the variable we found and check for other
+		 occurences of SYM in the use list.  */
+	      found_var = var, found_iface = iface;
+	  }
+      }
+
+    if (SCM_BOUND_THING_P (found_var))
+      {
+	/* Save the lookup result for future reference.  */
+	(void) scm_hashq_set_x (imports, sym, found_var);
+	return found_var;
+      }
+  }
+
+  return SCM_BOOL_F;
+#undef SCM_BOUND_THING_P
+}
+
+SCM_DEFINE (scm_module_local_variable, "module-local-variable", 2, 0, 0,
+	    (SCM module, SCM sym),
+	    "Return the variable bound to @var{sym} in @var{module}.  Return "
+	    "@code{#f} is @var{sym} is not bound locally in @var{module}.")
+#define FUNC_NAME s_scm_module_local_variable
 {
 #define SCM_BOUND_THING_P(b) \
   (scm_is_true (b))
 
+  register SCM b;
+
+  /* SCM_MODULE_TAG is not initialized yet when `boot-9.scm' is being
+     evaluated.  */
+  if (scm_module_system_booted_p)
+    SCM_VALIDATE_MODULE (1, module);
+
+  SCM_VALIDATE_SYMBOL (2, sym);
+
+
   /* 1. Check module obarray */
-  SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
+  b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
   if (SCM_BOUND_THING_P (b))
     return b;
+
+  /* 2. Search imported bindings.  In order to be consistent with
+     `module-variable', the binder gets called only when no imported binding
+     matches SYM.  */
+  b = module_imported_variable (module, sym);
+  if (SCM_BOUND_THING_P (b))
+    return SCM_BOOL_F;
+
   {
+    /* 3. Query the custom binder.  */
     SCM binder = SCM_MODULE_BINDER (module);
+
     if (scm_is_true (binder))
-      /* 2. Custom binder */
       {
 	b = scm_call_3 (binder, module, sym, SCM_BOOL_F);
 	if (SCM_BOUND_THING_P (b))
 	  return b;
       }
   }
+
+  return SCM_BOOL_F;
+
+#undef SCM_BOUND_THING_P
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_module_variable, "module-variable", 2, 0, 0,
+	    (SCM module, SCM sym),
+	    "Return the variable bound to @var{sym} in @var{module}.  This "
+	    "may be both a local variable or an imported variable.  Return "
+	    "@code{#f} is @var{sym} is not bound in @var{module}.")
+#define FUNC_NAME s_scm_module_variable
+{
+#define SCM_BOUND_THING_P(b) \
+  (scm_is_true (b))
+
+  register SCM var;
+
+  if (scm_module_system_booted_p)
+    SCM_VALIDATE_MODULE (1, module);
+
+  SCM_VALIDATE_SYMBOL (2, sym);
+
+  /* 1. Check module obarray */
+  var = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
+  if (SCM_BOUND_THING_P (var))
+    return var;
+
+  /* 2. Search among the imported variables.  */
+  var = module_imported_variable (module, sym);
+  if (SCM_BOUND_THING_P (var))
+    return var;
+
   {
-    /* 3. Search the use list */
-    SCM uses = SCM_MODULE_USES (module);
-    while (scm_is_pair (uses))
+    /* 3. Query the custom binder.  */
+    SCM binder;
+
+    binder = SCM_MODULE_BINDER (module);
+    if (scm_is_true (binder))
       {
-	b = module_variable (SCM_CAR (uses), sym);
-	if (SCM_BOUND_THING_P (b))
-	  return b;
-	uses = SCM_CDR (uses);
+	var = scm_call_3 (binder, module, sym, SCM_BOOL_F);
+	if (SCM_BOUND_THING_P (var))
+	  return var;
       }
-    return SCM_BOOL_F;
   }
+
+  return SCM_BOOL_F;
+
 #undef SCM_BOUND_THING_P
 }
+#undef FUNC_NAME
 
 scm_t_bits scm_tc16_eval_closure;
 
@@ -335,7 +509,7 @@
 			 module, sym);
     }
   else
-    return module_variable (module, sym);
+    return scm_module_variable (module, sym);
 }
 
 SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0,
@@ -398,38 +572,44 @@
 
 SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
 	    (SCM module, SCM sym),
-	    "")
+	    "Return the module or interface from which @var{sym} is imported "
+	    "in @var{module}.  If @var{sym} is not imported (i.e., it is not "
+	    "defined in @var{module} or it is a module-local binding instead "
+	    "of an imported one), then @code{#f} is returned.")
 #define FUNC_NAME s_scm_module_import_interface
 {
-#define SCM_BOUND_THING_P(b) (scm_is_true (b))
-  SCM uses;
-  SCM_VALIDATE_MODULE (SCM_ARG1, module);
-  /* Search the use list */
-  uses = SCM_MODULE_USES (module);
-  while (scm_is_pair (uses))
+  SCM var, result = SCM_BOOL_F;
+
+  SCM_VALIDATE_MODULE (1, module);
+  SCM_VALIDATE_SYMBOL (2, sym);
+
+  var = scm_module_variable (module, sym);
+  if (scm_is_true (var))
     {
-      SCM _interface = SCM_CAR (uses);
-      /* 1. Check module obarray */
-      SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (_interface), sym, SCM_BOOL_F);
-      if (SCM_BOUND_THING_P (b))
-	return _interface;
-      {
-	SCM binder = SCM_MODULE_BINDER (_interface);
-	if (scm_is_true (binder))
-	  /* 2. Custom binder */
-	  {
-	    b = scm_call_3 (binder, _interface, sym, SCM_BOOL_F);
-	    if (SCM_BOUND_THING_P (b))
-	      return _interface;
-	  }
-      }
-      /* 3. Search use list recursively. */
-      _interface = scm_module_import_interface (_interface, sym);
-      if (scm_is_true (_interface))
-	return _interface;
-      uses = SCM_CDR (uses);
+      /* Look for the module that provides VAR.  */
+      SCM local_var;
+
+      local_var = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym,
+				 SCM_UNDEFINED);
+      if (scm_is_eq (local_var, var))
+	result = module;
+      else
+	{
+	  /* Look for VAR among the used modules.  */
+	  SCM uses, imported_var;
+
+	  for (uses = SCM_MODULE_USES (module);
+	       scm_is_pair (uses) && scm_is_false (result);
+	       uses = SCM_CDR (uses))
+	    {
+	      imported_var = scm_module_variable (SCM_CAR (uses), sym);
+	      if (scm_is_eq (imported_var, var))
+		result = SCM_CAR (uses);
+	    }
+	}
     }
-  return SCM_BOOL_F;
+
+  return result;
 }
 #undef FUNC_NAME
 
@@ -560,9 +740,13 @@
   return var;
 }
 
-SCM
-scm_module_reverse_lookup (SCM module, SCM variable)
-#define FUNC_NAME "module-reverse-lookup"
+SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
+	    (SCM module, SCM variable),
+	    "Return the symbol under which @var{variable} is bound in "
+	    "@var{module} or @var{#f} if @var{variable} is not visible "
+	    "from @var{module}.  If @var{module} is @code{#f}, then the "
+	    "pre-module obarray is used.")
+#define FUNC_NAME s_scm_module_reverse_lookup
 {
   SCM obarray;
   long i, n;
@@ -594,8 +778,7 @@
 	}
     }
 
-  /* Try the `uses' list. 
-   */
+  /* Try the `uses' list.  */
   {
     SCM uses = SCM_MODULE_USES (module);
     while (scm_is_pair (uses))
@@ -669,6 +852,8 @@
   process_use_modules_var = PERM (scm_c_lookup ("process-use-modules"));
   module_export_x_var = PERM (scm_c_lookup ("module-export!"));
   the_root_module_var = PERM (scm_c_lookup ("the-root-module"));
+  default_duplicate_binding_procedures_var =
+    PERM (scm_c_lookup ("default-duplicate-binding-procedures"));
 
   scm_module_system_booted_p = 1;
 }


--- orig/libguile/modules.h
+++ mod/libguile/modules.h
@@ -45,6 +45,8 @@
 #define scm_module_index_binder		2
 #define scm_module_index_eval_closure	3
 #define scm_module_index_transformer	4
+#define scm_module_index_duplicate_handlers 7
+#define scm_module_index_import_obarray 12
 
 #define SCM_MODULE_OBARRAY(module) \
   SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_obarray])
@@ -56,6 +58,10 @@
   SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure])
 #define SCM_MODULE_TRANSFORMER(module) \
   SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_transformer])
+#define SCM_MODULE_DUPLICATE_HANDLERS(module) \
+  SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_duplicate_handlers])
+#define SCM_MODULE_IMPORT_OBARRAY(module) \
+  SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_import_obarray])
 
 SCM_API scm_t_bits scm_tc16_eval_closure;
 
@@ -64,6 +70,8 @@
 \f
 
 SCM_API SCM scm_current_module (void);
+SCM_API SCM scm_module_variable (SCM module, SCM sym);
+SCM_API SCM scm_module_local_variable (SCM module, SCM sym);
 SCM_API SCM scm_interaction_environment (void);
 SCM_API SCM scm_set_current_module (SCM module);
 
@@ -80,6 +88,7 @@
 SCM_API SCM scm_c_module_define (SCM module, const char *name, SCM val);
 SCM_API SCM scm_module_lookup (SCM module, SCM symbol);
 SCM_API SCM scm_module_define (SCM module, SCM symbol, SCM val);
+SCM_API SCM scm_module_export (SCM module, SCM symbol_list);
 SCM_API SCM scm_module_reverse_lookup (SCM module, SCM variable);
 
 SCM_API SCM scm_c_resolve_module (const char *name);


--- orig/test-suite/tests/modules.test
+++ mod/test-suite/tests/modules.test
@@ -1,6 +1,6 @@
 ;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*-
 
-;;;; Copyright (C) 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -16,10 +16,270 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
-(use-modules (test-suite lib))
+(define-module (test-suite test-modules)
+  :use-module (srfi srfi-1)
+  :use-module ((ice-9 streams)  ;; for test purposes
+               #:renamer (symbol-prefix-proc 's:))
+  :use-module (test-suite lib))
+
+
+(define (every? . args)
+  (not (not (apply every args))))
+
+
+\f
+;;;
+;;; Foundations.
+;;;
+
+(with-test-prefix "foundations"
+
+  (pass-if "module-add!"
+    (let ((m (make-module))
+          (value (cons 'x 'y)))
+      (module-add! m 'something (make-variable value))
+      (eq? (module-ref m 'something) value)))
+
+  (pass-if "module-define!"
+    (let ((m (make-module))
+          (value (cons 'x 'y)))
+      (module-define! m 'something value)
+      (eq? (module-ref m 'something) value)))
+
+  (pass-if "module-use!"
+    (let ((m (make-module))
+          (import (make-module)))
+      (module-define! m 'something 'something)
+      (module-define! import 'imported 'imported)
+      (module-use! m import)
+      (and (eq? (module-ref m 'something) 'something)
+           (eq? (module-ref m 'imported)  'imported)
+           (module-local-variable m 'something)
+           (not (module-local-variable m 'imported))
+           #t)))
+
+  (pass-if "module-use! (duplicates local binding)"
+    ;; Imported bindings can't override locale bindings.
+    (let ((m (make-module))
+          (import (make-module)))
+      (module-define! m 'something 'something)
+      (module-define! import 'something 'imported)
+      (module-use! m import)
+      (eq? (module-ref m 'something) 'something)))
+
+  (pass-if "module-locally-bound?"
+     (let ((m (make-module))
+           (import (make-module)))
+       (module-define! m 'something #t)
+       (module-define! import 'imported #t)
+       (module-use! m import)
+       (and (module-locally-bound? m 'something)
+            (not (module-locally-bound? m 'imported)))))
+
+  (pass-if "module-{local-,}variable"
+     (let ((m (make-module))
+           (import (make-module)))
+       (module-define! m 'local #t)
+       (module-define! import 'imported #t)
+       (module-use! m import)
+       (and (module-local-variable m 'local)
+            (not (module-local-variable m 'imported))
+            (eq? (module-variable m 'local)
+                 (module-local-variable m 'local))
+            (eq? (module-local-variable import 'imported)
+                 (module-variable m 'imported)))))
+
+  (pass-if "module-import-interface"
+    (and (every? (lambda (sym iface)
+                   (eq? (module-import-interface (current-module) sym)
+                        iface))
+                 '(current-module exception:bad-variable every)
+                 (cons the-scm-module
+                       (map resolve-interface
+                            '((test-suite lib) (srfi srfi-1)))))
+
+         ;; For renamed bindings, a custom interface is used so we can't
+         ;; check for equality with `eq?'.
+         (every? (lambda (sym iface)
+                   (let ((import
+                          (module-import-interface (current-module) sym)))
+                     (equal? (module-name import)
+                             (module-name iface))))
+                 '(s:make-stream s:stream-car s:stream-cdr)
+                 (make-list 3 (resolve-interface '(ice-9 streams))))))
+
+  (pass-if "module-reverse-lookup"
+    (let ((mods   '((srfi srfi-1) (test-suite lib)      (ice-9 streams)))
+          (syms   '(every         exception:bad-variable make-stream))
+          (locals '(every         exception:bad-variable s:make-stream)))
+      (every? (lambda (var sym)
+                (eq? (module-reverse-lookup (current-module) var)
+                     sym))
+              (map module-variable
+                   (map resolve-interface mods)
+                   syms)
+              locals))))
+
+
+\f
+;;;
+;;; Observers.
+;;;
+
+(with-test-prefix "observers"
+
+  (pass-if "weak observer invoked"
+    (let* ((m (make-module))
+           (invoked 0))
+      (module-observe-weak m (lambda (mod)
+                               (if (eq? mod m)
+                                   (set! invoked (+ invoked 1)))))
+      (module-define! m 'something 2)
+      (module-define! m 'something-else 1)
+      (= invoked 2)))
+
+  (pass-if "all weak observers invoked"
+    (let* ((m (make-module))
+           (observer-count 500)
+           (observer-ids (let loop ((i observer-count)
+                                    (ids '()))
+                           (if (= i 0)
+                               ids
+                               (loop (- i 1) (cons (make-module) ids)))))
+           (observers-invoked (make-hash-table observer-count)))
+
+      ;; register weak observers
+      (for-each (lambda (id)
+                  (module-observe-weak m id
+                                       (lambda (m)
+                                         (hashq-set! observers-invoked
+                                                     id #t))))
+                observer-ids)
+
+      ;; invoke them
+      (module-call-observers m)
+
+      ;; make sure all of them were invoked
+      (->bool (every (lambda (id)
+                       (hashq-ref observers-invoked id))
+                     observer-ids))))
+
+  (pass-if "imported bindings updated"
+    (let ((m (make-module))
+          (imported (make-module)))
+      ;; Beautify them, notably adding them a public interface.
+      (beautify-user-module! m)
+      (beautify-user-module! imported)
+
+      (module-use! m (module-public-interface imported))
+      (module-define! imported 'imported-binding #t)
+
+      ;; At this point, `imported-binding' is local to IMPORTED.
+      (and (not (module-variable m 'imported-binding))
+           (begin
+             ;; Export `imported-binding' from IMPORTED.
+             (module-export! imported '(imported-binding))
+
+             ;; Make sure it is now visible from M.
+             (module-ref m 'imported-binding))))))
+
+
+\f
+;;;
+;;; Duplicate bindings handling.
+;;;
+
+(with-test-prefix "duplicate bindings"
+
+  (pass-if "simple duplicate handler"
+    ;; Import the same binding twice.
+    (let* ((m (make-module))
+           (import1 (make-module))
+           (import2 (make-module))
+           (handler-invoked? #f)
+           (handler (lambda (module name int1 val1 int2 val2 var val)
+                      (set! handler-invoked? #t)
+                      ;; Keep the first binding.
+                      (or var (module-local-variable int1 name)))))
+
+      (set-module-duplicates-handlers! m (list handler))
+      (module-define! m 'something 'something)
+      (set-module-name! import1 'imported-module-1)
+      (set-module-name! import2 'imported-module-2)
+      (module-define! import1 'imported 'imported-1)
+      (module-define! import2 'imported 'imported-2)
+      (module-use! m import1)
+      (module-use! m import2)
+      (and (eq? (module-ref m 'imported) 'imported-1)
+           handler-invoked?))))
+
+\f
+;;;
+;;; Lazy binder.
+;;;
+
+(with-test-prefix "lazy binder"
+
+  (pass-if "not invoked"
+    (let ((m (make-module))
+          (invoked? #f))
+      (module-define! m 'something 2)
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (and (module-ref m 'something)
+           (not invoked?))))
+
+  (pass-if "not invoked (module-add!)"
+    (let ((m (make-module))
+          (invoked? #f))
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (module-add! m 'something (make-variable 2))
+      (and (module-ref m 'something)
+           (not invoked?))))
+
+  (pass-if "invoked (module-ref)"
+    (let ((m (make-module))
+          (invoked? #f))
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (false-if-exception (module-ref m 'something))
+      invoked?))
+
+  (pass-if "invoked (module-define!)"
+    (let ((m (make-module))
+          (invoked? #f))
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (module-define! m 'something 2)
+      (and invoked?
+           (eq? (module-ref m 'something) 2))))
+
+  (pass-if "honored (ref)"
+    (let ((m (make-module))
+          (invoked? #f)
+          (value (cons 'x 'y)))
+      (set-module-binder! m
+                          (lambda (mod sym define?)
+                            (set! invoked? #t)
+                            (cond ((not (eq? m mod))
+                                   (error "invalid module" mod))
+                                  (define?
+                                   (error "DEFINE? shouldn't be set"))
+                                  (else
+                                   (make-variable value)))))
+      (and (eq? (module-ref m 'something) value)
+           invoked?))))
+
+
+\f
+;;;
+;;; Higher-level features.
+;;;
 
 (with-test-prefix "autoload"
 
+  (pass-if "module-autoload!"
+     (let ((m (make-module)))
+       (module-autoload! m '(ice-9 q) '(make-q))
+       (not (not (module-ref m 'make-q)))))
+
   (pass-if "autoloaded"
      (catch #t
        (lambda ()


[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-04-08 23:06               ` Ludovic Courtès
@ 2007-04-08 23:25                 ` Ludovic Courtès
  0 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2007-04-08 23:25 UTC (permalink / raw)
  To: guile-devel

Oops, I hit `C-c C-c' too early.  :-)

Ludo'.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-04-08 23:24               ` Ludovic Courtès
@ 2007-04-30  8:39                 ` Ludovic Courtès
  2007-05-05 20:48                   ` Ludovic Courtès
  0 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2007-04-30  8:39 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guile-devel

Hi,

ludo@chbouib.org (Ludovic Courtès) writes:

> Attached is a patch that implements lazy duplicate checking.
> `process-duplicates' is gone and `module-variable' plays its role when
> an imported variable is looked up for the first time.  Subsequent
> lookups for the same variable result in a "cache hit", i.e., the result
> is fetched directly from the "import obarray".

Folks, I'm willing to install this patch in HEAD one of these days since
it provides an appreciable performance improvement.  Please let me know
if you are strongly opposed to this.

Note that just because it's committed doesn't mean that it's "set in
stone", so we can certainly modify it eventually.

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel


^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-04-30  8:39                 ` Ludovic Courtès
@ 2007-05-05 20:48                   ` Ludovic Courtès
  2010-07-20 21:20                     ` Andy Wingo
  0 siblings, 1 reply; 18+ messages in thread
From: Ludovic Courtès @ 2007-05-05 20:48 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 980 bytes --]

Hi,

ludovic.courtes@laas.fr (Ludovic Courtès) writes:

> Folks, I'm willing to install this patch in HEAD one of these days since
> it provides an appreciable performance improvement.  Please let me know
> if you are strongly opposed to this.

I just committed this lazy duplicate binding handling thing in HEAD.
Attached is the exact patch that went in.

API changes include the new `module-autoload!', which is meant to be the
official way of autoloading a module (although I haven't written the doc
yet).  `module-observe-weak' has been changed too (in a
backward-compatible way) to address a bug in the previous API, namely
the fact that an observer would get unregistered when PROC is
unregistered (see `modules.test' for a test case).

My intent is to eventually document all (or most of) the `module-'
procedures, for instance under an "Introspection" node within the
"Modules" node.

Please test it with your favorite programs and report any problem.

Thanks,
Ludovic.



[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 43561 bytes --]

--- orig/ice-9/ChangeLog
+++ mod/ice-9/ChangeLog
@@ -1,3 +1,41 @@
+2007-05-05  Ludovic Courtès  <ludo@chbouib.org>
+
+	Implemented lazy duplicate binding handling.  Fixed the
+	`module-observe-weak' API.
+
+	* boot-9.scm: Updated the `module-type' documentation under "{Low
+	Level Modules}".
+	(module-type)[import-obarray]: New slot.
+	[duplicates-interface, observer-id]: Removed.
+	(make-module): Updated accordingly.  Use a weak-key hash table for
+	weak observers, so that observers aren't unregistered when the
+	observing closure gets GC'd.
+	(module-duplicates-interface, set-module-duplicates-interface!,
+	module-observer-id, set-module-observer-id!): Removed.
+	(module-import-obarray): New.
+	(module-observe-weak): Accept a new OBSERVER-ID argument allowing
+	callers control over when the observer will get unregistered.
+	(module-call-observers): Use `hash-for-each' rather than
+	`hash-fold'.
+	(module-local-variable, module-variable): Removed, now implemented
+	in C.
+	(module-make-local-var!): Simplified.  No need to check for the
+	value of a same-named imported binding since the newly created
+	variable is systematically assigned afterwards.
+	(module-use!): Check whether MODULE and INTERFACE are `eq?'.
+	(module-use-interfaces!): Simplified.  No longer calls
+	`process-duplicates'.
+	(beautify-user-module!): Use `module-use!' rather than
+	`set-module-uses!' when importing THE-SCM-MODULE.
+	(process-define-module): Added an AUTOLOADS local variable so that
+	autoloads are handled separately from regular interfaces.
+	(make-autoload-interface): Updated `module-constructor'
+	invocation.
+	(module-autoload!): New.
+	(make-duplicates-interface, process-duplicates): Removed.
+	(top-repl): Use `module-autoload!' rather than
+	`make-autoload-interface'.
+	
 2007-02-18  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* gds-client.scm (connect-to-gds): Break generation of client name
--- orig/ice-9/boot-9.scm
+++ mod/ice-9/boot-9.scm
@@ -1098,18 +1098,20 @@
 ;;;   'module, 'directory, 'interface, 'custom-interface.  If no explicit kind
 ;;;   is set, it defaults to 'module.
 ;;;
-;;; - duplicates-handlers
+;;; - duplicates-handlers: a list of procedures that get called to make a
+;;;   choice between two duplicate bindings when name clashes occur.  See the
+;;;   `duplicate-handlers' global variable below.
 ;;;
-;;; - duplicates-interface
+;;; - observers: a list of procedures that get called when the module is
+;;;   modified.
 ;;;
-;;; - observers
-;;;
-;;; - weak-observers
-;;;
-;;; - observer-id
+;;; - weak-observers: a weak-key hash table of procedures that get called
+;;;   when the module is modified.  See `module-observe-weak' for details.
 ;;;
 ;;; In addition, the module may (must?) contain a binding for
-;;; %module-public-interface... More explanations here...
+;;; `%module-public-interface'.  This variable should be bound to a module
+;;; representing the exported interface of a module.  See the
+;;; `module-public-interface' and `module-export!' procedures.
 ;;;
 ;;; !!! warning: The interface to lazy binder procedures is going
 ;;; to be changed in an incompatible way to permit all the basic
@@ -1173,8 +1175,8 @@
 (define module-type
   (make-record-type 'module
 		    '(obarray uses binder eval-closure transformer name kind
-		      duplicates-handlers duplicates-interface
-		      observers weak-observers observer-id)
+		      duplicates-handlers import-obarray
+		      observers weak-observers)
 		    %print-module))
 
 ;; make-module &opt size uses binder
@@ -1190,6 +1192,10 @@
 	    (list-ref args index)
 	    default))
 
+      (define %default-import-size
+        ;; Typical number of imported bindings actually used by a module.
+        600)
+
       (if (> (length args) 3)
 	  (error "Too many args to make-module." args))
 
@@ -1207,10 +1213,10 @@
 	     "Lazy-binder expected to be a procedure or #f." binder))
 
 	(let ((module (module-constructor (make-hash-table size)
-					  uses binder #f #f #f #f #f #f
+					  uses binder #f #f #f #f #f
+					  (make-hash-table %default-import-size)
 					  '()
-					  (make-weak-value-hash-table 31)
-					  0)))
+					  (make-weak-key-hash-table 31))))
 
 	  ;; We can't pass this as an argument to module-constructor,
 	  ;; because we need it to close over a pointer to the module
@@ -1240,17 +1246,13 @@
   (record-accessor module-type 'duplicates-handlers))
 (define set-module-duplicates-handlers!
   (record-modifier module-type 'duplicates-handlers))
-(define module-duplicates-interface
-  (record-accessor module-type 'duplicates-interface))
-(define set-module-duplicates-interface!
-  (record-modifier module-type 'duplicates-interface))
 (define module-observers (record-accessor module-type 'observers))
 (define set-module-observers! (record-modifier module-type 'observers))
 (define module-weak-observers (record-accessor module-type 'weak-observers))
-(define module-observer-id (record-accessor module-type 'observer-id))
-(define set-module-observer-id! (record-modifier module-type 'observer-id))
 (define module? (record-predicate module-type))
 
+(define module-import-obarray (record-accessor module-type 'import-obarray))
+
 (define set-module-eval-closure!
   (let ((setter (record-modifier module-type 'eval-closure)))
     (lambda (module closure)
@@ -1269,11 +1271,19 @@
   (set-module-observers! module (cons proc (module-observers module)))
   (cons module proc))
 
-(define (module-observe-weak module proc)
-  (let ((id (module-observer-id module)))
-    (hash-set! (module-weak-observers module) id proc)
-    (set-module-observer-id! module (+ 1 id))
-    (cons module id)))
+(define (module-observe-weak module observer-id . proc)
+  ;; Register PROC as an observer of MODULE under name OBSERVER-ID (which can
+  ;; be any Scheme object).  PROC is invoked and passed MODULE any time
+  ;; MODULE is modified.  PROC gets unregistered when OBSERVER-ID gets GC'd
+  ;; (thus, it is never unregistered if OBSERVER-ID is an immediate value,
+  ;; for instance).
+
+  ;; The two-argument version is kept for backward compatibility: when called
+  ;; with two arguments, the observer gets unregistered when closure PROC
+  ;; gets GC'd (making it impossible to use an anonymous lambda for PROC).
+
+  (let ((proc (if (null? proc) observer-id (car proc))))
+    (hashq-set! (module-weak-observers module) observer-id proc)))
 
 (define (module-unobserve token)
   (let ((module (car token))
@@ -1311,7 +1321,11 @@
 
 (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)))
+
+  ;; We assume that weak observers don't (un)register themselves as they are
+  ;; called since this would preclude proper iteration over the hash table
+  ;; elements.
+  (hash-for-each (lambda (id proc) (proc m)) (module-weak-observers m)))
 
 \f
 
@@ -1435,26 +1449,8 @@
 ;;;
 ;;; If the symbol is not found at all, return #f.
 ;;;
-(define (module-local-variable m v)
-;  (caddr
-;   (list m v
-	 (let ((b (module-obarray-ref (module-obarray m) v)))
-	   (or (and (variable? b) b)
-	       (and (module-binder m)
-		    ((module-binder m) m v #f)))))
-;))
-
-;; module-variable module symbol
-;;
-;; like module-local-variable, except search the uses in the
-;; case V is not found in M.
-;;
-;; NOTE: This function is superseded with C code (see modules.c)
-;;;      when using the standard eval closure.
-;;
-(define (module-variable m v)
-  (module-search module-local-variable m v))
-
+;;; (This is now written in C, see `modules.c'.)
+;;;
 
 ;;; {Mapping modules x symbols --> bindings}
 ;;;
@@ -1515,19 +1511,10 @@
 	       (module-modified m)
 	       b)))
 
-      ;; No local variable yet, so we need to create a new one.  That
-      ;; new variable is initialized with the old imported value of V,
-      ;; if there is one.
-      (let ((imported-var (module-variable m v))
-	    (local-var (or (and (module-binder m)
-				((module-binder m) m v #t))
-			   (begin
-			     (let ((answer (make-undefined-variable)))
-			       (module-add! m v answer)
-			       answer)))))
-	(if (and imported-var (not (variable-bound? local-var)))
-	    (variable-set! local-var (variable-ref imported-var)))
-	local-var)))
+      ;; Create a new local variable.
+      (let ((local-var (make-undefined-variable)))
+        (module-add! m v local-var)
+        local-var)))
 
 ;; module-ensure-local-variable! module symbol
 ;;
@@ -1696,46 +1683,29 @@
 ;; Add INTERFACE to the list of interfaces used by MODULE.
 ;;
 (define (module-use! module interface)
-  (set-module-uses! module
-		    (cons interface
-			  (filter (lambda (m)
-				    (not (equal? (module-name m)
-						 (module-name interface))))
-				  (module-uses module))))
-  (module-modified module))
+  (if (not (eq? module interface))
+      (begin
+        ;; Newly used modules must be appended rather than consed, so that
+        ;; `module-variable' traverses the use list starting from the first
+        ;; used module.
+        (set-module-uses! module
+                          (append (filter (lambda (m)
+                                            (not
+                                             (equal? (module-name m)
+                                                     (module-name interface))))
+                                          (module-uses module))
+                                  (list interface)))
+
+        (module-modified module))))
 
 ;; MODULE-USE-INTERFACES! module interfaces
 ;;
 ;; Same as MODULE-USE! but add multiple interfaces and check for duplicates
 ;;
 (define (module-use-interfaces! module interfaces)
-  (let* ((duplicates-handlers? (or (module-duplicates-handlers module)
-				   (default-duplicate-binding-procedures)))
-	 (uses (module-uses module)))
-    ;; remove duplicates-interface
-    (set! uses (delq! (module-duplicates-interface module) uses))
-    ;; remove interfaces to be added
-    (for-each (lambda (interface)
-		(set! uses
-		      (filter (lambda (m)
-				(not (equal? (module-name m)
-					     (module-name interface))))
-			      uses)))
-	      interfaces)
-    ;; add interfaces to use list
-    (set-module-uses! module uses)
-    (for-each (lambda (interface)
-		(and duplicates-handlers?
-		     ;; perform duplicate checking
-		     (process-duplicates module interface))
-		(set! uses (cons interface uses))
-		(set-module-uses! module uses))
-	      interfaces)
-    ;; add duplicates interface
-    (if (module-duplicates-interface module)
-	(set-module-uses! module
-			  (cons (module-duplicates-interface module) uses)))
-    (module-modified module)))
+  (set-module-uses! module
+                    (append (module-uses module) interfaces))
+  (module-modified module))
 
 \f
 
@@ -1861,8 +1831,8 @@
 	  (set-module-public-interface! module interface))))
   (if (and (not (memq the-scm-module (module-uses module)))
 	   (not (eq? module the-root-module)))
-      (set-module-uses! module
-			(append (module-uses module) (list the-scm-module)))))
+      ;; Import the default set of bindings (from the SCM module) in MODULE.
+      (module-use! module the-scm-module)))
 
 ;; NOTE: This binding is used in libguile/modules.c.
 ;;
@@ -1893,6 +1863,7 @@
 (define process-define-module #f)
 (define process-use-modules #f)
 (define module-export! #f)
+(define default-duplicate-binding-procedures #f)
 
 ;; This boots the module system.  All bindings needed by modules.c
 ;; must have been defined by now.
@@ -2027,7 +1998,8 @@
 	       (reversed-interfaces '())
 	       (exports '())
 	       (re-exports '())
-	       (replacements '()))
+	       (replacements '())
+               (autoloads '()))
 
       (if (null? kws)
 	  (call-with-deferred-observers
@@ -2035,7 +2007,9 @@
 	     (module-use-interfaces! module (reverse reversed-interfaces))
 	     (module-export! module exports)
 	     (module-replace! module replacements)
-	     (module-re-export! module re-exports)))
+	     (module-re-export! module re-exports)
+             (if (not (null? autoloads))
+                 (apply module-autoload! module autoloads))))
 	  (case (car kws)
 	    ((#:use-module #:use-syntax)
 	     (or (pair? (cdr kws))
@@ -2055,31 +2029,35 @@
 		     (cons interface reversed-interfaces)
 		     exports
 		     re-exports
-		     replacements)))
+		     replacements
+                     autoloads)))
 	    ((#:autoload)
 	     (or (and (pair? (cdr kws)) (pair? (cddr kws)))
 		 (unrecognized kws))
 	     (loop (cdddr kws)
-		   (cons (make-autoload-interface module
-						  (cadr kws)
-						  (caddr kws))
-			 reversed-interfaces)
+                   reversed-interfaces
 		   exports
 		   re-exports
-		   replacements))
+		   replacements
+                   (let ((name (cadr kws))
+                         (bindings (caddr kws)))
+                     (cons* name bindings autoloads))))
 	    ((#:no-backtrace)
 	     (set-system-module! module #t)
-	     (loop (cdr kws) reversed-interfaces exports re-exports replacements))
+	     (loop (cdr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
 	    ((#:pure)
 	     (purify-module! module)
-	     (loop (cdr kws) reversed-interfaces exports re-exports replacements))
+	     (loop (cdr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
 	    ((#:duplicates)
 	     (if (not (pair? (cdr kws)))
 		 (unrecognized kws))
 	     (set-module-duplicates-handlers!
 	      module
 	      (lookup-duplicates-handlers (cadr kws)))
-	     (loop (cddr kws) reversed-interfaces exports re-exports replacements))
+	     (loop (cddr kws) reversed-interfaces exports re-exports
+                   replacements autoloads))
 	    ((#:export #:export-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
@@ -2087,7 +2065,8 @@
 		   reversed-interfaces
 		   (append (cadr kws) exports)
 		   re-exports
-		   replacements))
+		   replacements
+                   autoloads))
 	    ((#:re-export #:re-export-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
@@ -2095,7 +2074,8 @@
 		   reversed-interfaces
 		   exports
 		   (append (cadr kws) re-exports)
-		   replacements))
+		   replacements
+                   autoloads))
 	    ((#:replace #:replace-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
@@ -2103,7 +2083,8 @@
 		   reversed-interfaces
 		   exports
 		   re-exports
-		   (append (cadr kws) replacements)))
+		   (append (cadr kws) replacements)
+                   autoloads))
 	    (else
 	     (unrecognized kws)))))
     (run-hook module-defined-hook module)
@@ -2131,8 +2112,26 @@
 		      (if (pair? autoload)
 			  (set-car! autoload i)))
 		    (module-local-variable i sym))))))
-    (module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f #f
-			'() (make-weak-value-hash-table 31) 0)))
+    (module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f
+                        (make-hash-table 0) '() (make-weak-value-hash-table 31))))
+
+(define (module-autoload! module . args)
+  "Have @var{module} automatically load the module named @var{name} when one
+of the symbols listed in @var{bindings} is looked up.  @var{args} should be a
+list of module-name/binding-list pairs, e.g., as in @code{(module-autoload!
+module '(ice-9 q) '(make-q q-length))}."
+  (let loop ((args args))
+    (cond ((null? args)
+           #t)
+          ((null? (cdr args))
+           (error "invalid name+binding autoload list" args))
+          (else
+           (let ((name     (car args))
+                 (bindings (cadr args)))
+             (module-use! module (make-autoload-interface module
+                                                          name bindings))
+             (loop (cddr args)))))))
+
 
 ;;; {Compiled module}
 
@@ -3133,57 +3132,6 @@
 			      (lookup-duplicates-handlers handler-names))
 			    handler-names)))
 
-(define (make-duplicates-interface)
-  (let ((m (make-module)))
-    (set-module-kind! m 'custom-interface)
-    (set-module-name! m 'duplicates)
-    m))
-
-(define (process-duplicates module interface)
-  (let* ((duplicates-handlers (or (module-duplicates-handlers module)
-				  (default-duplicate-binding-procedures)))
-	 (duplicates-interface (module-duplicates-interface module)))
-    (module-for-each
-     (lambda (name var)
-       (cond ((module-import-interface module name)
-	      =>
-	      (lambda (prev-interface)
-		(let ((var1 (module-local-variable prev-interface name))
-		      (var2 (module-local-variable interface name)))
-		  (if (not (eq? var1 var2))
-		      (begin
-			(if (not duplicates-interface)
-			    (begin
-			      (set! duplicates-interface
-				    (make-duplicates-interface))
-			      (set-module-duplicates-interface!
-			       module
-			       duplicates-interface)))
-			(let* ((var (module-local-variable duplicates-interface
-							   name))
-			       (val (and var
-					 (variable-bound? var)
-					 (variable-ref var))))
-			  (let loop ((duplicates-handlers duplicates-handlers))
-			    (cond ((null? duplicates-handlers))
-				  (((car duplicates-handlers)
-				    module
-				    name
-				    prev-interface
-				    (and (variable-bound? var1)
-					 (variable-ref var1))
-				    interface
-				    (and (variable-bound? var2)
-					 (variable-ref var2))
-				    var
-				    val)
-				   =>
-				   (lambda (var)
-				     (module-add! duplicates-interface name var)))
-				  (else
-				   (loop (cdr duplicates-handlers)))))))))))))
-     interface)))
-
 \f
 
 ;;; {`cond-expand' for SRFI-0 support.}
@@ -3398,10 +3346,7 @@
 	  '(((ice-9 threads)))
 	  '())))
     ;; load debugger on demand
-    (module-use! guile-user-module
-		 (make-autoload-interface guile-user-module
-					  '(ice-9 debugger) '(debug)))
-
+    (module-autoload! guile-user-module '(ice-9 debugger) '(debug))
 
     ;; Note: SIGFPE, SIGSEGV and SIGBUS are actually "query-only" (see
     ;; scmsigs.c scm_sigaction_for_thread), so the handlers setup here have
--- orig/libguile/ChangeLog
+++ mod/libguile/ChangeLog
@@ -1,3 +1,21 @@
+2007-05-05  Ludovic Courtès  <ludo@chbouib.org>
+
+	Implemented lazy duplicate binding handling.
+
+	* modules.c (scm_export): Renamed to...
+	(scm_module_export): This.  Now public.
+	(module_variable): Removed.
+	(default_duplicate_binding_procedures_var): New variable.
+	(default_duplicate_binding_handlers, resolve_duplicate_binding,
+	module_imported_variable, scm_module_local_variable,
+	scm_module_variable): New functions.
+	(scm_module_import_interface): Rewritten.
+	(scm_module_reverse_lookup): Exported as a Scheme function.
+	* modules.h (scm_module_index_duplicate_handlers,
+	scm_module_index_import_obarray): New macros.
+	(scm_module_variable, scm_module_local_variable,
+	scm_module_export): New declarations.
+
 2007-04-17  Ludovic Courtès  <ludovic.courtes@laas.fr>
 
 	* numbers.c: Commented out trailing `HAVE_COMPLEX_DOUBLE' after
--- orig/libguile/modules.c
+++ mod/libguile/modules.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1998,2000,2001,2002, 2003, 2004, 2006 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007 Free Software Foundation, Inc.
+ *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
  * License as published by the Free Software Foundation; either
@@ -162,12 +162,8 @@ scm_c_use_module (const char *name)
 
 static SCM module_export_x_var;
 
-
-/*
-  TODO: should export this function? --hwn.
- */
-static SCM
-scm_export (SCM module, SCM namelist)
+SCM
+scm_module_export (SCM module, SCM namelist)
 {
   return scm_call_2 (SCM_VARIABLE_REF (module_export_x_var),
 		     module, namelist);
@@ -203,7 +199,7 @@ scm_c_export (const char *name, ...)
 	  tail = SCM_CDRLOC (*tail);
 	}
       va_end (ap);
-      scm_export (scm_current_module(), names);
+      scm_module_export (scm_current_module (), names);
     }
 }
 
@@ -278,42 +274,220 @@ SCM_DEFINE (scm_env_module, "env-module"
  * release.
  */
 
-static SCM module_make_local_var_x_var;
+/* The `module-make-local-var!' variable.  */
+static SCM module_make_local_var_x_var = SCM_UNSPECIFIED;
 
-static SCM
-module_variable (SCM module, SCM sym)
+/* The `default-duplicate-binding-procedures' variable.  */
+static SCM default_duplicate_binding_procedures_var = SCM_UNSPECIFIED;
+
+/* Return the list of default duplicate binding handlers (procedures).  */
+static inline SCM
+default_duplicate_binding_handlers (void)
+{
+  SCM get_handlers;
+
+  get_handlers = SCM_VARIABLE_REF (default_duplicate_binding_procedures_var);
+
+  return (scm_call_0 (get_handlers));
+}
+
+/* Resolve the import of SYM in MODULE, where SYM is currently provided by
+   both IFACE1 as VAR1 and IFACE2 as VAR2.  Return the variable chosen by the
+   duplicate binding handlers or `#f'.  */
+static inline SCM
+resolve_duplicate_binding (SCM module, SCM sym,
+			   SCM iface1, SCM var1,
+			   SCM iface2, SCM var2)
+{
+  SCM result = SCM_BOOL_F;
+
+  if (!scm_is_eq (var1, var2))
+    {
+      SCM val1, val2;
+      SCM handlers, h, handler_args;
+
+      val1 = SCM_VARIABLE_REF (var1);
+      val2 = SCM_VARIABLE_REF (var2);
+
+      val1 = (val1 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val1;
+      val2 = (val2 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val2;
+
+      handlers = SCM_MODULE_DUPLICATE_HANDLERS (module);
+      if (scm_is_false (handlers))
+	handlers = default_duplicate_binding_handlers ();
+
+      handler_args = scm_list_n (module, sym,
+				 iface1, val1, iface2, val2,
+				 var1, val1,
+				 SCM_UNDEFINED);
+
+      for (h = handlers;
+	   scm_is_pair (h) && scm_is_false (result);
+	   h = SCM_CDR (h))
+	{
+	  result = scm_apply (SCM_CAR (h), handler_args, SCM_EOL);
+	}
+    }
+  else
+    result = var1;
+
+  return result;
+}
+
+/* Lookup SYM as an imported variable of MODULE.  */
+static inline SCM
+module_imported_variable (SCM module, SCM sym)
+{
+#define SCM_BOUND_THING_P scm_is_true
+  register SCM var, imports;
+
+  /* Search cached imported bindings.  */
+  imports = SCM_MODULE_IMPORT_OBARRAY (module);
+  var = scm_hashq_ref (imports, sym, SCM_UNDEFINED);
+  if (SCM_BOUND_THING_P (var))
+    return var;
+
+  {
+    /* Search the use list for yet uncached imported bindings, possibly
+       resolving duplicates as needed and caching the result in the import
+       obarray.  */
+    SCM uses;
+    SCM found_var = SCM_BOOL_F, found_iface = SCM_BOOL_F;
+
+    for (uses = SCM_MODULE_USES (module);
+	 scm_is_pair (uses);
+	 uses = SCM_CDR (uses))
+      {
+	SCM iface;
+
+	iface = SCM_CAR (uses);
+	var = scm_module_variable (iface, sym);
+
+	if (SCM_BOUND_THING_P (var))
+	  {
+	    if (SCM_BOUND_THING_P (found_var))
+	      {
+		/* SYM is a duplicate binding (imported more than once) so we
+		   need to resolve it.  */
+		found_var = resolve_duplicate_binding (module, sym,
+						       found_iface, found_var,
+						       iface, var);
+		if (scm_is_eq (found_var, var))
+		  found_iface = iface;
+	      }
+	    else
+	      /* Keep track of the variable we found and check for other
+		 occurences of SYM in the use list.  */
+	      found_var = var, found_iface = iface;
+	  }
+      }
+
+    if (SCM_BOUND_THING_P (found_var))
+      {
+	/* Save the lookup result for future reference.  */
+	(void) scm_hashq_set_x (imports, sym, found_var);
+	return found_var;
+      }
+  }
+
+  return SCM_BOOL_F;
+#undef SCM_BOUND_THING_P
+}
+
+SCM_DEFINE (scm_module_local_variable, "module-local-variable", 2, 0, 0,
+	    (SCM module, SCM sym),
+	    "Return the variable bound to @var{sym} in @var{module}.  Return "
+	    "@code{#f} is @var{sym} is not bound locally in @var{module}.")
+#define FUNC_NAME s_scm_module_local_variable
 {
 #define SCM_BOUND_THING_P(b) \
   (scm_is_true (b))
 
+  register SCM b;
+
+  /* SCM_MODULE_TAG is not initialized yet when `boot-9.scm' is being
+     evaluated.  */
+  if (scm_module_system_booted_p)
+    SCM_VALIDATE_MODULE (1, module);
+
+  SCM_VALIDATE_SYMBOL (2, sym);
+
+
   /* 1. Check module obarray */
-  SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
+  b = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
   if (SCM_BOUND_THING_P (b))
     return b;
+
+  /* 2. Search imported bindings.  In order to be consistent with
+     `module-variable', the binder gets called only when no imported binding
+     matches SYM.  */
+  b = module_imported_variable (module, sym);
+  if (SCM_BOUND_THING_P (b))
+    return SCM_BOOL_F;
+
   {
+    /* 3. Query the custom binder.  */
     SCM binder = SCM_MODULE_BINDER (module);
+
     if (scm_is_true (binder))
-      /* 2. Custom binder */
       {
 	b = scm_call_3 (binder, module, sym, SCM_BOOL_F);
 	if (SCM_BOUND_THING_P (b))
 	  return b;
       }
   }
+
+  return SCM_BOOL_F;
+
+#undef SCM_BOUND_THING_P
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_module_variable, "module-variable", 2, 0, 0,
+	    (SCM module, SCM sym),
+	    "Return the variable bound to @var{sym} in @var{module}.  This "
+	    "may be both a local variable or an imported variable.  Return "
+	    "@code{#f} is @var{sym} is not bound in @var{module}.")
+#define FUNC_NAME s_scm_module_variable
+{
+#define SCM_BOUND_THING_P(b) \
+  (scm_is_true (b))
+
+  register SCM var;
+
+  if (scm_module_system_booted_p)
+    SCM_VALIDATE_MODULE (1, module);
+
+  SCM_VALIDATE_SYMBOL (2, sym);
+
+  /* 1. Check module obarray */
+  var = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym, SCM_UNDEFINED);
+  if (SCM_BOUND_THING_P (var))
+    return var;
+
+  /* 2. Search among the imported variables.  */
+  var = module_imported_variable (module, sym);
+  if (SCM_BOUND_THING_P (var))
+    return var;
+
   {
-    /* 3. Search the use list */
-    SCM uses = SCM_MODULE_USES (module);
-    while (scm_is_pair (uses))
+    /* 3. Query the custom binder.  */
+    SCM binder;
+
+    binder = SCM_MODULE_BINDER (module);
+    if (scm_is_true (binder))
       {
-	b = module_variable (SCM_CAR (uses), sym);
-	if (SCM_BOUND_THING_P (b))
-	  return b;
-	uses = SCM_CDR (uses);
+	var = scm_call_3 (binder, module, sym, SCM_BOOL_F);
+	if (SCM_BOUND_THING_P (var))
+	  return var;
       }
-    return SCM_BOOL_F;
   }
+
+  return SCM_BOOL_F;
+
 #undef SCM_BOUND_THING_P
 }
+#undef FUNC_NAME
 
 scm_t_bits scm_tc16_eval_closure;
 
@@ -335,7 +509,7 @@ scm_eval_closure_lookup (SCM eclo, SCM s
 			 module, sym);
     }
   else
-    return module_variable (module, sym);
+    return scm_module_variable (module, sym);
 }
 
 SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0,
@@ -398,38 +572,44 @@ scm_current_module_transformer ()
 
 SCM_DEFINE (scm_module_import_interface, "module-import-interface", 2, 0, 0,
 	    (SCM module, SCM sym),
-	    "")
+	    "Return the module or interface from which @var{sym} is imported "
+	    "in @var{module}.  If @var{sym} is not imported (i.e., it is not "
+	    "defined in @var{module} or it is a module-local binding instead "
+	    "of an imported one), then @code{#f} is returned.")
 #define FUNC_NAME s_scm_module_import_interface
 {
-#define SCM_BOUND_THING_P(b) (scm_is_true (b))
-  SCM uses;
-  SCM_VALIDATE_MODULE (SCM_ARG1, module);
-  /* Search the use list */
-  uses = SCM_MODULE_USES (module);
-  while (scm_is_pair (uses))
-    {
-      SCM _interface = SCM_CAR (uses);
-      /* 1. Check module obarray */
-      SCM b = scm_hashq_ref (SCM_MODULE_OBARRAY (_interface), sym, SCM_BOOL_F);
-      if (SCM_BOUND_THING_P (b))
-	return _interface;
-      {
-	SCM binder = SCM_MODULE_BINDER (_interface);
-	if (scm_is_true (binder))
-	  /* 2. Custom binder */
-	  {
-	    b = scm_call_3 (binder, _interface, sym, SCM_BOOL_F);
-	    if (SCM_BOUND_THING_P (b))
-	      return _interface;
-	  }
-      }
-      /* 3. Search use list recursively. */
-      _interface = scm_module_import_interface (_interface, sym);
-      if (scm_is_true (_interface))
-	return _interface;
-      uses = SCM_CDR (uses);
+  SCM var, result = SCM_BOOL_F;
+
+  SCM_VALIDATE_MODULE (1, module);
+  SCM_VALIDATE_SYMBOL (2, sym);
+
+  var = scm_module_variable (module, sym);
+  if (scm_is_true (var))
+    {
+      /* Look for the module that provides VAR.  */
+      SCM local_var;
+
+      local_var = scm_hashq_ref (SCM_MODULE_OBARRAY (module), sym,
+				 SCM_UNDEFINED);
+      if (scm_is_eq (local_var, var))
+	result = module;
+      else
+	{
+	  /* Look for VAR among the used modules.  */
+	  SCM uses, imported_var;
+
+	  for (uses = SCM_MODULE_USES (module);
+	       scm_is_pair (uses) && scm_is_false (result);
+	       uses = SCM_CDR (uses))
+	    {
+	      imported_var = scm_module_variable (SCM_CAR (uses), sym);
+	      if (scm_is_eq (imported_var, var))
+		result = SCM_CAR (uses);
+	    }
+	}
     }
-  return SCM_BOOL_F;
+
+  return result;
 }
 #undef FUNC_NAME
 
@@ -560,9 +740,13 @@ scm_define (SCM sym, SCM value)
   return var;
 }
 
-SCM
-scm_module_reverse_lookup (SCM module, SCM variable)
-#define FUNC_NAME "module-reverse-lookup"
+SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
+	    (SCM module, SCM variable),
+	    "Return the symbol under which @var{variable} is bound in "
+	    "@var{module} or @var{#f} if @var{variable} is not visible "
+	    "from @var{module}.  If @var{module} is @code{#f}, then the "
+	    "pre-module obarray is used.")
+#define FUNC_NAME s_scm_module_reverse_lookup
 {
   SCM obarray;
   long i, n;
@@ -594,8 +778,7 @@ scm_module_reverse_lookup (SCM module, S
 	}
     }
 
-  /* Try the `uses' list. 
-   */
+  /* Try the `uses' list.  */
   {
     SCM uses = SCM_MODULE_USES (module);
     while (scm_is_pair (uses))
@@ -669,6 +852,8 @@ scm_post_boot_init_modules ()
   process_use_modules_var = PERM (scm_c_lookup ("process-use-modules"));
   module_export_x_var = PERM (scm_c_lookup ("module-export!"));
   the_root_module_var = PERM (scm_c_lookup ("the-root-module"));
+  default_duplicate_binding_procedures_var =
+    PERM (scm_c_lookup ("default-duplicate-binding-procedures"));
 
   scm_module_system_booted_p = 1;
 }
--- orig/libguile/modules.h
+++ mod/libguile/modules.h
@@ -3,7 +3,7 @@
 #ifndef SCM_MODULES_H
 #define SCM_MODULES_H
 
-/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -45,6 +45,8 @@ SCM_API scm_t_bits scm_module_tag;
 #define scm_module_index_binder		2
 #define scm_module_index_eval_closure	3
 #define scm_module_index_transformer	4
+#define scm_module_index_duplicate_handlers 7
+#define scm_module_index_import_obarray 8
 
 #define SCM_MODULE_OBARRAY(module) \
   SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_obarray])
@@ -56,6 +58,10 @@ SCM_API scm_t_bits scm_module_tag;
   SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure])
 #define SCM_MODULE_TRANSFORMER(module) \
   SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_transformer])
+#define SCM_MODULE_DUPLICATE_HANDLERS(module) \
+  SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_duplicate_handlers])
+#define SCM_MODULE_IMPORT_OBARRAY(module) \
+  SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_import_obarray])
 
 SCM_API scm_t_bits scm_tc16_eval_closure;
 
@@ -64,6 +70,8 @@ SCM_API scm_t_bits scm_tc16_eval_closure
 \f
 
 SCM_API SCM scm_current_module (void);
+SCM_API SCM scm_module_variable (SCM module, SCM sym);
+SCM_API SCM scm_module_local_variable (SCM module, SCM sym);
 SCM_API SCM scm_interaction_environment (void);
 SCM_API SCM scm_set_current_module (SCM module);
 
@@ -80,6 +88,7 @@ SCM_API SCM scm_c_module_lookup (SCM mod
 SCM_API SCM scm_c_module_define (SCM module, const char *name, SCM val);
 SCM_API SCM scm_module_lookup (SCM module, SCM symbol);
 SCM_API SCM scm_module_define (SCM module, SCM symbol, SCM val);
+SCM_API SCM scm_module_export (SCM module, SCM symbol_list);
 SCM_API SCM scm_module_reverse_lookup (SCM module, SCM variable);
 
 SCM_API SCM scm_c_resolve_module (const char *name);
--- orig/oop/ChangeLog
+++ mod/oop/ChangeLog
@@ -1,3 +1,8 @@
+2007-05-05  Ludovic Courtès  <ludo@chbouib.org>
+
+	* goops/internal.scm: Use the public module API rather than hack
+	with `%module-public-interface', `nested-ref', et al.
+
 2005-03-24  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
 	* accessors.scm, simple.scm: New files.
--- orig/oop/goops/internal.scm
+++ mod/oop/goops/internal.scm
@@ -21,5 +21,10 @@
 (define-module (oop goops internal)
   :use-module (oop goops))
 
-(set-module-uses! %module-public-interface
-		  (list (nested-ref the-root-module '(app modules oop goops))))
+;; Export all the bindings that are internal to `(oop goops)'.
+(let ((public-i (module-public-interface (current-module))))
+  (module-for-each (lambda (name var)
+                     (if (eq? name '%module-public-interface)
+                         #t
+                         (module-add! public-i name var)))
+                   (resolve-module '(oop goops))))
--- orig/test-suite/ChangeLog
+++ mod/test-suite/ChangeLog
@@ -1,3 +1,10 @@
+2007-05-05  Ludovic Courtès  <ludo@chbouib.org>
+
+	* tests/modules.test: Use `define-module'.  Use `(srfi srfi-1)'.
+	(foundations, observers, duplicate bindings, lazy binder): New
+	test prefixes.
+	(autoload)[module-autoload!]: New test.
+
 2007-03-08  Kevin Ryde  <user42@zip.com.au>
 
 	* tests/structs.test (make-struct): Exercise the error check on tail
--- orig/test-suite/tests/modules.test
+++ mod/test-suite/tests/modules.test
@@ -1,6 +1,6 @@
 ;;;; modules.test --- exercise some of guile's module stuff -*- scheme -*-
 
-;;;; Copyright (C) 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -16,10 +16,277 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
-(use-modules (test-suite lib))
+(define-module (test-suite test-modules)
+  :use-module (srfi srfi-1)
+  :use-module ((ice-9 streams)  ;; for test purposes
+               #:renamer (symbol-prefix-proc 's:))
+  :use-module (test-suite lib))
+
+
+(define (every? . args)
+  (not (not (apply every args))))
+
+
+\f
+;;;
+;;; Foundations.
+;;;
+
+(with-test-prefix "foundations"
+
+  (pass-if "module-add!"
+    (let ((m (make-module))
+          (value (cons 'x 'y)))
+      (module-add! m 'something (make-variable value))
+      (eq? (module-ref m 'something) value)))
+
+  (pass-if "module-define!"
+    (let ((m (make-module))
+          (value (cons 'x 'y)))
+      (module-define! m 'something value)
+      (eq? (module-ref m 'something) value)))
+
+  (pass-if "module-use!"
+    (let ((m (make-module))
+          (import (make-module)))
+      (module-define! m 'something 'something)
+      (module-define! import 'imported 'imported)
+      (module-use! m import)
+      (and (eq? (module-ref m 'something) 'something)
+           (eq? (module-ref m 'imported)  'imported)
+           (module-local-variable m 'something)
+           (not (module-local-variable m 'imported))
+           #t)))
+
+  (pass-if "module-use! (duplicates local binding)"
+    ;; Imported bindings can't override locale bindings.
+    (let ((m (make-module))
+          (import (make-module)))
+      (module-define! m 'something 'something)
+      (module-define! import 'something 'imported)
+      (module-use! m import)
+      (eq? (module-ref m 'something) 'something)))
+
+  (pass-if "module-locally-bound?"
+     (let ((m (make-module))
+           (import (make-module)))
+       (module-define! m 'something #t)
+       (module-define! import 'imported #t)
+       (module-use! m import)
+       (and (module-locally-bound? m 'something)
+            (not (module-locally-bound? m 'imported)))))
+
+  (pass-if "module-{local-,}variable"
+     (let ((m (make-module))
+           (import (make-module)))
+       (module-define! m 'local #t)
+       (module-define! import 'imported #t)
+       (module-use! m import)
+       (and (module-local-variable m 'local)
+            (not (module-local-variable m 'imported))
+            (eq? (module-variable m 'local)
+                 (module-local-variable m 'local))
+            (eq? (module-local-variable import 'imported)
+                 (module-variable m 'imported)))))
+
+  (pass-if "module-import-interface"
+    (and (every? (lambda (sym iface)
+                   (eq? (module-import-interface (current-module) sym)
+                        iface))
+                 '(current-module exception:bad-variable every)
+                 (cons the-scm-module
+                       (map resolve-interface
+                            '((test-suite lib) (srfi srfi-1)))))
+
+         ;; For renamed bindings, a custom interface is used so we can't
+         ;; check for equality with `eq?'.
+         (every? (lambda (sym iface)
+                   (let ((import
+                          (module-import-interface (current-module) sym)))
+                     (equal? (module-name import)
+                             (module-name iface))))
+                 '(s:make-stream s:stream-car s:stream-cdr)
+                 (make-list 3 (resolve-interface '(ice-9 streams))))))
+
+  (pass-if "module-reverse-lookup"
+    (let ((mods   '((srfi srfi-1) (test-suite lib)      (ice-9 streams)))
+          (syms   '(every         exception:bad-variable make-stream))
+          (locals '(every         exception:bad-variable s:make-stream)))
+      (every? (lambda (var sym)
+                (eq? (module-reverse-lookup (current-module) var)
+                     sym))
+              (map module-variable
+                   (map resolve-interface mods)
+                   syms)
+              locals))))
+
+
+\f
+;;;
+;;; Observers.
+;;;
+
+(with-test-prefix "observers"
+
+  (pass-if "weak observer invoked"
+    (let* ((m (make-module))
+           (invoked 0))
+      (module-observe-weak m (lambda (mod)
+                               (if (eq? mod m)
+                                   (set! invoked (+ invoked 1)))))
+      (module-define! m 'something 2)
+      (module-define! m 'something-else 1)
+      (= invoked 2)))
+
+  (pass-if "all weak observers invoked"
+    ;; With the two-argument `module-observe-weak' available in previous
+    ;; versions, the observer would get unregistered as soon as the observing
+    ;; closure gets GC'd, making it impossible to use an anonymous lambda as
+    ;; the observing procedure.
+
+    (let* ((m (make-module))
+           (observer-count 500)
+           (observer-ids (let loop ((i observer-count)
+                                    (ids '()))
+                           (if (= i 0)
+                               ids
+                               (loop (- i 1) (cons (make-module) ids)))))
+           (observers-invoked (make-hash-table observer-count)))
+
+      ;; register weak observers
+      (for-each (lambda (id)
+                  (module-observe-weak m id
+                                       (lambda (m)
+                                         (hashq-set! observers-invoked
+                                                     id #t))))
+                observer-ids)
+
+      (gc)
+
+      ;; invoke them
+      (module-call-observers m)
+
+      ;; make sure all of them were invoked
+      (->bool (every (lambda (id)
+                       (hashq-ref observers-invoked id))
+                     observer-ids))))
+
+  (pass-if "imported bindings updated"
+    (let ((m (make-module))
+          (imported (make-module)))
+      ;; Beautify them, notably adding them a public interface.
+      (beautify-user-module! m)
+      (beautify-user-module! imported)
+
+      (module-use! m (module-public-interface imported))
+      (module-define! imported 'imported-binding #t)
+
+      ;; At this point, `imported-binding' is local to IMPORTED.
+      (and (not (module-variable m 'imported-binding))
+           (begin
+             ;; Export `imported-binding' from IMPORTED.
+             (module-export! imported '(imported-binding))
+
+             ;; Make sure it is now visible from M.
+             (module-ref m 'imported-binding))))))
+
+
+\f
+;;;
+;;; Duplicate bindings handling.
+;;;
+
+(with-test-prefix "duplicate bindings"
+
+  (pass-if "simple duplicate handler"
+    ;; Import the same binding twice.
+    (let* ((m (make-module))
+           (import1 (make-module))
+           (import2 (make-module))
+           (handler-invoked? #f)
+           (handler (lambda (module name int1 val1 int2 val2 var val)
+                      (set! handler-invoked? #t)
+                      ;; Keep the first binding.
+                      (or var (module-local-variable int1 name)))))
+
+      (set-module-duplicates-handlers! m (list handler))
+      (module-define! m 'something 'something)
+      (set-module-name! import1 'imported-module-1)
+      (set-module-name! import2 'imported-module-2)
+      (module-define! import1 'imported 'imported-1)
+      (module-define! import2 'imported 'imported-2)
+      (module-use! m import1)
+      (module-use! m import2)
+      (and (eq? (module-ref m 'imported) 'imported-1)
+           handler-invoked?))))
+
+\f
+;;;
+;;; Lazy binder.
+;;;
+
+(with-test-prefix "lazy binder"
+
+  (pass-if "not invoked"
+    (let ((m (make-module))
+          (invoked? #f))
+      (module-define! m 'something 2)
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (and (module-ref m 'something)
+           (not invoked?))))
+
+  (pass-if "not invoked (module-add!)"
+    (let ((m (make-module))
+          (invoked? #f))
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (module-add! m 'something (make-variable 2))
+      (and (module-ref m 'something)
+           (not invoked?))))
+
+  (pass-if "invoked (module-ref)"
+    (let ((m (make-module))
+          (invoked? #f))
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (false-if-exception (module-ref m 'something))
+      invoked?))
+
+  (pass-if "invoked (module-define!)"
+    (let ((m (make-module))
+          (invoked? #f))
+      (set-module-binder! m (lambda args (set! invoked? #t) #f))
+      (module-define! m 'something 2)
+      (and invoked?
+           (eq? (module-ref m 'something) 2))))
+
+  (pass-if "honored (ref)"
+    (let ((m (make-module))
+          (invoked? #f)
+          (value (cons 'x 'y)))
+      (set-module-binder! m
+                          (lambda (mod sym define?)
+                            (set! invoked? #t)
+                            (cond ((not (eq? m mod))
+                                   (error "invalid module" mod))
+                                  (define?
+                                   (error "DEFINE? shouldn't be set"))
+                                  (else
+                                   (make-variable value)))))
+      (and (eq? (module-ref m 'something) value)
+           invoked?))))
+
+
+\f
+;;;
+;;; Higher-level features.
+;;;
 
 (with-test-prefix "autoload"
 
+  (pass-if "module-autoload!"
+     (let ((m (make-module)))
+       (module-autoload! m '(ice-9 q) '(make-q))
+       (not (not (module-ref m 'make-q)))))
+
   (pass-if "autoloaded"
      (catch #t
        (lambda ()

[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2007-05-05 20:48                   ` Ludovic Courtès
@ 2010-07-20 21:20                     ` Andy Wingo
  2010-07-20 22:24                       ` Ludovic Courtès
  0 siblings, 1 reply; 18+ messages in thread
From: Andy Wingo @ 2010-07-20 21:20 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guile-devel

Heya,

Guess what I found ;-)

On Sat 05 May 2007 22:48, ludo@chbouib.org (Ludovic Courtès) writes:

> My intent is to eventually document all (or most of) the `module-'
> procedures, for instance under an "Introspection" node within the
> "Modules" node.

/me taps fingers, wondering about the meaning of "eventually" ;-)

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 18+ messages in thread

* Re: Evolution & optimization of the module system
  2010-07-20 21:20                     ` Andy Wingo
@ 2010-07-20 22:24                       ` Ludovic Courtès
  0 siblings, 0 replies; 18+ messages in thread
From: Ludovic Courtès @ 2010-07-20 22:24 UTC (permalink / raw)
  To: Andy Wingo; +Cc: guile-devel

Hello!

Andy Wingo <wingo@pobox.com> writes:

> Guess what I found ;-)
>
> On Sat 05 May 2007 22:48, ludo@chbouib.org (Ludovic Courtès) writes:
>
>> My intent is to eventually document all (or most of) the `module-'
>> procedures, for instance under an "Introspection" node within the
>> "Modules" node.
>
> /me taps fingers, wondering about the meaning of "eventually" ;-)

Arrrgh, that must have been an impostor!  The Internet is an unsafe
place.

(That said, I do agree with this guy that it’s a worthy thing to
do...  eventually?)

Thanks,
Ludo’.



^ permalink raw reply	[flat|nested] 18+ messages in thread

end of thread, other threads:[~2010-07-20 22:24 UTC | newest]

Thread overview: 18+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2007-02-17 15:15 Evolution & optimization of the module system Ludovic Courtès
2007-02-18 23:32 ` Kevin Ryde
2007-02-19  9:24   ` Ludovic Courtès
2007-02-21 22:21     ` Kevin Ryde
2007-02-22  9:20       ` Ludovic Courtès
2007-02-22 22:23         ` Kevin Ryde
2007-02-23 13:15           ` Ludovic Courtès
2007-02-25 23:37             ` Kevin Ryde
2007-02-26 21:15               ` Ludovic Courtès
2007-02-26 22:46                 ` Kevin Ryde
2007-02-27  8:21                   ` Ludovic Courtès
2007-04-08 23:06               ` Ludovic Courtès
2007-04-08 23:25                 ` Ludovic Courtès
2007-04-08 23:24               ` Ludovic Courtès
2007-04-30  8:39                 ` Ludovic Courtès
2007-05-05 20:48                   ` Ludovic Courtès
2010-07-20 21:20                     ` Andy Wingo
2010-07-20 22:24                       ` Ludovic Courtès

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).