* boot-9.scm (beautify-user-module!): Beautify also if public

interface is set to the module itself.  In this way we can use
beautify-user-module! to beautify a module prepared for object
code.
(process-define-module): Special case: Try to load object code as
well if a module does :use-module on itself.
* boot-9.scm: Bugfix: Since boot-9.scm is now loaded from
invoke_main_func, we can no longer be sure that all modules have
been registered when boot-9.scm is loaded.
(register-modules): New function: Register and tag modules
registered by scm_register_module_xxx since last call to this
function.  Modules are tagged with the dynamic object passed as
argument.  (Already linked modules should be tagged with #f.)
(init-dynamic-module, link-dynamic-module): Call register-modules
first to register linked modules.
* boot-9.scm (init-dynamic-module): Remove module from
registered-modules as soon as possible in case we are recursively
invoked; Set public interface before doing the dynamic-call.
* boot-9.scm (map-in-order): Removed (replaced by scm_serial_map).
(abort-hook, before-error-hook, after-error-hook,
before-backtrace-hook, after-backtrace-hook, before-read-hook,
after-read-hook, exit-hook): Make hooks with `make-hook'.
* boot-9.scm: Make hooks first class citizens and make them easier
to use from C:
(make-hook, add-hook!, remove-hook!, run-hooks): Moved to
libguile/feature.c.
* boot-9.scm: Added warnings about bindings used in
libguile/modules.c: the-module, set-current-module,
make-modules-in, beautify-user-module!, module-eval-closure.

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index ad857a3..6adca39 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -519,7 +519,7 @@
 
 
 \f
-;;; {and-map, or-map, and map-in-order}
+;;; {and-map and or-map}
 ;;;
 ;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)
 ;;; (or-map fn lst) is like (or (fn (car lst)) (fn (cadr lst)) (fn...) ...)
@@ -552,37 +552,6 @@
        (and (not (null? l))
             (loop (f (car l)) (cdr l))))))
 
-;; map-in-order
-;;
-;; Like map, but guaranteed to process the list in order.
-;;
-(define (map-in-order fn l)
-  (if (null? l)
-      '()
-      (cons (fn (car l))
-           (map-in-order fn (cdr l)))))
-
-\f
-;;; {Hooks}
-(define (run-hooks hook)
-  (for-each (lambda (thunk) (thunk)) hook))
-
-(define add-hook!
-  (procedure->macro
-    (lambda (exp env)
-      `(let ((thunk ,(caddr exp)))
-        (if (not (memq thunk ,(cadr exp)))
-            (set! ,(cadr exp)
-                  (cons thunk ,(cadr exp))))))))
-
-(define remove-hook!
-  (procedure->macro
-    (lambda (exp env)
-      `(let ((thunk ,(caddr exp)))
-        (if (memq thunk ,(cadr exp))
-            (set! ,(cadr exp)
-                  (delq! thunk ,(cadr exp))))))))
-
 \f
 ;;; {Files}
 ;;;
@@ -1881,20 +1850,22 @@
 (define (resolve-module name . maybe-autoload)
   (let ((full-name (append '(app modules) name)))
     (let ((already (local-ref full-name)))
-    (or already
-       (begin
-         (if (or (null? maybe-autoload) (car maybe-autoload))
-             (or (try-module-linked name)
-                 (try-module-autoload name)
-                 (try-module-dynamic-link name)))
-         (make-modules-in (current-module) full-name))))))
+      (or already
+         (begin
+           (if (or (null? maybe-autoload) (car maybe-autoload))
+               (or (try-module-linked name)
+                   (try-module-autoload name)
+                   (try-module-dynamic-link name)))
+           (make-modules-in (current-module) full-name))))))
            
 (define (beautify-user-module! module)
-  (if (not (module-public-interface module))
-      (let ((interface (make-module 31)))
-       (set-module-name! interface (module-name module))
-       (set-module-kind! interface 'interface)
-       (set-module-public-interface! module interface)))
+  (let ((interface (module-public-interface module)))
+    (if (or (not interface)
+           (eq? interface module))
+       (let ((interface (make-module 31)))
+         (set-module-name! interface (module-name module))
+         (set-module-kind! interface 'interface)
+         (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)))))
@@ -1905,7 +1876,8 @@
   (if (null? name)
       module
       (cond
-       ((module-ref module (car name) #f) => (lambda (m) (make-modules-in m (cdr name))))
+       ((module-ref module (car name) #f)
+       => (lambda (m) (make-modules-in m (cdr name))))
        (else   (let ((m (make-module 31)))
                  (set-module-kind! m 'directory)
                  (set-module-name! m (car name))
@@ -1946,19 +1918,29 @@
                   (error "unrecognized defmodule argument" kws))
               (let* ((used-name (cadr kws))
                      (used-module (resolve-module used-name)))
-                (if (not (module-ref used-module '%module-public-interface #f))
+                (if (eq? used-module module)
                     (begin
-                      ((if %autoloader-developer-mode warn error)
-                       "no code for module" (module-name used-module))
-                      (beautify-user-module! used-module)))
-                (let ((interface (module-public-interface used-module)))
-                  (if (not interface)
-                      (error "missing interface for use-module" used-module))
-                  (if (eq? keyword 'use-syntax)
-                      (internal-use-syntax
-                       (module-ref interface (car (last-pair used-name))
-                                   #f)))
-                  (loop (cddr kws) (cons interface reversed-interfaces)))))
+                      (or (try-module-linked used-name)
+                          (try-module-dynamic-link used-name))
+                      (loop (cddr kws) reversed-interfaces))
+                    (begin
+                      (if (not (module-ref used-module
+                                           '%module-public-interface
+                                           #f))
+                          (begin
+                            ((if %autoloader-developer-mode warn error)
+                             "no code for module" (module-name used-module))
+                            (beautify-user-module! used-module)))
+                      (let ((interface (module-public-interface used-module)))
+                        (if (not interface)
+                            (error "missing interface for use-module"
+                                   used-module))
+                        (if (eq? keyword 'use-syntax)
+                            (internal-use-syntax
+                             (module-ref interface (car (last-pair used-name))
+                                         #f)))
+                        (loop (cddr kws)
+                              (cons interface reversed-interfaces)))))))
              (else     
               (error "unrecognized defmodule argument" kws))))))
     module))
@@ -2076,18 +2058,26 @@
     (c-clear-registered-modules)
     res))
 
-(define registered-modules (convert-c-registered-modules #f))
-    
+(define registered-modules '())
+
+(define (register-modules dynobj)
+  (set! registered-modules
+       (append! (convert-c-registered-modules dynobj)
+                registered-modules)))
+
 (define (init-dynamic-module modname)
+  ;; Register any linked modules which has been registered on the C level
+  (register-modules #f)
   (or-map (lambda (modinfo)
            (if (equal? (car modinfo) modname)
+               (set! registered-modules (delq! modinfo registered-modules))
                (let ((mod (resolve-module modname #f)))
                  (save-module-excursion
                   (lambda ()
                     (set-current-module mod)
+                    (set-module-public-interface! mod mod)
                     (dynamic-call (cadr modinfo) (caddr modinfo))
-                    (set-module-public-interface! mod mod)))
-                 (set! registered-modules (delq! modinfo registered-modules))
+                    ))
                  #t)
                #f))
          registered-modules))
@@ -2170,11 +2160,11 @@
   (in-vicinity libdir (string-append libname ".so")))
 
 (define (link-dynamic-module filename initname)
+  ;; Register any linked modules which has been registered on the C level
+  (register-modules #f)
   (let ((dynobj (dynamic-link filename)))
     (dynamic-call initname dynobj)
-    (set! registered-modules 
-         (append! (convert-c-registered-modules dynobj)
-                  registered-modules))))
+    (register-modules dynobj)))
 
 (define (try-module-linked module-name)
   (init-dynamic-module module-name))
@@ -2429,7 +2419,7 @@
     (else
      (apply default-lazy-handler key args))))
 
-(define abort-hook '())
+(define abort-hook (make-hook))
 
 ;; these definitions are used if running a script.
 ;; otherwise redefined in error-catching-loop.
@@ -2542,10 +2532,10 @@
                         (apply make-stack #t save-stack id narrowing))))))
         (set! stack-saved? #t))))
 
-(define before-error-hook '())
-(define after-error-hook '())
-(define before-backtrace-hook '())
-(define after-backtrace-hook '())
+(define before-error-hook (make-hook))
+(define after-error-hook (make-hook))
+(define before-backtrace-hook (make-hook))
+(define after-backtrace-hook (make-hook))
 
 (define has-shown-debugger-hint? #f)
 
@@ -2593,8 +2583,8 @@
 (define (gc-run-time)
   (cdr (assq 'gc-time-taken (gc-stats))))
 
-(define before-read-hook '())
-(define after-read-hook '())
+(define before-read-hook (make-hook))
+(define after-read-hook (make-hook))
 
 ;;; The default repl-reader function.  We may override this if we've
 ;;; the readline library.
@@ -3015,7 +3005,7 @@
 
 ;;; This hook is run at the very end of an interactive session.
 ;;;
-(define exit-hook '())
+(define exit-hook (make-hook))
 
 ;;; Load readline code into root module if readline primitives are available.
 ;;;