version-ref target))))))

(define (make-fresh-user-module)
  (let ((m (make-module)))
    (beautify-user-module! m)
    m))

;; NOTE: This binding is used in libguile/modules.c.
;;
(define resolve-module
  (let ((root (make-module)))
    (set-module-name! root '())
    ;; Define the-root-module as '(guile).
    (module-define-submodule! root 'guile the-root-module)

    (lambda* (name #:optional (autoload #t) (version #f) #:key (ensure #t))
      (call-with-module-autoload-lock
       (lambda ()
         (let ((already (nested-ref-module root name)))
           (cond
            ((and already
                  (or (not autoload) (module-public-interface already)))
             ;; A hit, a palpable hit.
             (if (and version
                      (not (version-matches? version (module-version already))))
                 (error "incompatible module version already loaded" name))
             already)
            (autoload
             ;; Try to autoload the module, and recurse.
             (try-load-module name version)
             (resolve-module name #f #:ensure ensure))
            (else
             ;; No module found (or if one was, it had no public interface), and
             ;; we're not autoloading. Make an empty module if #:ensure is true.
             (or already
                 (and ensure
                      (make-modules-in root name)))))))))))


(define (try-load-module name version)
  (try-module-autoload name version))

(define (reload-module m)
  "Revisit the source file corresponding to the module @var{m}."
  (let ((f (module-filename m)))
    (if f
        (save-module-excursion
         (lambda () 
           ;; Re-set the initial environment, as in try-module-autoload.
           (set-current-module (make-fresh-user-module))
           (primitive-load-path f)
           m))
        ;; Though we could guess, we *should* know it.
        (error "unknown file name for module" m))))

(define (purify-module! module)
  "Removes bindings in MODULE which are inherited from the (guile) module."
  (let ((use-list (module-uses module)))
    (if (and (pair? use-list)
             (eq? (car (last-pair use-list)) the-scm-module))
        (set-module-uses! module (reverse (cdr (reverse use-list)))))))

(define* (resolve-interface name #:key
                            (select #f)
                            (hide '())
                            (prefix #f)
                            (renamer (if prefix
                                         (symbol-prefix-proc prefix)
                                         identity))
                            version)
  "Return a module that is an interface to the module designated by
NAME.

`resolve-interface' takes four keyword arguments:

  #:select SELECTION

SELECTION is a list of binding-specs to be imported; A binding-spec
is either a symbol or a pair of symbols (ORIG . SEEN), where ORIG
is the name in the used module and SEEN is the name in the using
module.  Note that SEEN is also passed through RENAMER, below.  The
default is to select all bindings.  If you specify no selection but
a renamer, only the bindings that already exist in the used module
are made available in the interface.  Bindings that are added later
are not picked up.

  #:hide BINDINGS

BINDINGS is a list of bindings which should not be imported.

  #:prefix PREFIX

PREFIX is a symbol that will be appended to each exported name.
The default is to not perform any renaming.

  #:renamer RENAMER

RENAMER is a procedure that takes a symbol and returns its new
name.  The default is not perform any renaming.

Signal \"no code for module\" error if module name is not resolvable
or its public interface is not available.  Signal \"no binding\"
error if selected binding does not exist in the used module."
  (let* ((module (resolve-module name #t version #:ensure #f))
         (public-i (and module (module-public-interface module))))
    (unless public-i
      (error "no code for module" name))
    (if (and (not select) (null? hide) (eq? renamer identity))
        public-i
        (let ((selection (or select (module-map (lambda (sym var) sym)
                                                public-i)))
              (custom-i (make-module 31)))
          (set-module-kind! custom-i 'custom-interface)
          (set-module-name! custom-i name)
          ;; XXX - should use a lazy binder so that changes to the
          ;; used module are picked up automatically.
          (for-each (lambda (bspec)
                      (let* ((direct? (symbol? bspec))
                             (orig (if direct? bspec (car bspec)))
                             (seen (if direct? bspec (cdr bspec)))
                             (var (or (module-local-variable public-i orig)
                                      (error
                                       ;; fixme: format manually for now
                                       (simple-format
                                        #f "no binding `~A' in module ~A"
                                        orig name)))))
                        (if (memq orig hide)
                            (set! hide (delq! orig hide))
                            (module-add! custom-i
                                         (renamer seen)
                                         var))))
                    selection)
          ;; Check that we are not hiding bindings which don't exist
          (for-each (lambda (binding)
                      (if (not (module-local-variable public-i binding))
                          (error
                           (simple-format
                            #f "no binding `~A' to hide in module ~A"
                            binding name))))
                    hide)
          custom-i))))

(define (symbol-prefix-proc prefix)
  (lambda (symbol)
    (symbol-append prefix symbol)))

;; This function is called from "modules.c".  If you change it, be
;; sure to update "modules.c" as well.

(define* (define-module* name
           #:key filename pure version (imports '()) (exports '())
           (replacements '()) (re-exports '()) (autoloads '())
           (duplicates #f) transformer)
  (define (list-of pred l)
    (or (null? l)
        (and (pair? l) (pred (car l)) (list-of pred (cdr l)))))
  (define (valid-import? x)
    (list? x))
  (define (valid-export? x)
    (or (symbol? x) (and (pair? x) (symbol? (car x)) (symbol? (cdr x)))))
  (define (valid-autoload? x)
    (and (pair? x) (list-of symbol? (car x)) (list-of symbol? (cdr x))))
  
  ;; We could add a #:no-check arg, set by the define-module macro, if
  ;; these checks are taking too much time.
  ;;
  (let ((module (resolve-module name #f)))
    (beautify-user-module! module)
    (when filename
      (set-module-filename! module filename))
    (when pure
      (purify-module! module))
    (when version
      (unless (list-of integer? version)
        (error "expected list of integers for version"))
      (set-module-version! module version)
      (set-module-version! (module-public-interface module) version))
    (call-with-deferred-observers
     (lambda ()
       (unless (list-of valid-import? imports)
         (error "expected imports to be a list of import specifications"))
       (unless (list-of valid-export? exports)
         (error "expected exports to be a list of symbols or symbol pairs"))
       (unless (list-of valid-export? replacements)
         (error "expected replacements to be a list of symbols or symbol pairs"))
       (unless (list-of valid-export? re-exports)
         (error "expected re-exports to be a list of symbols or symbol pairs"))
       (module-export! module exports)
       (module-replace! module replacements)
       (unless (null? imports)
         (let ((imports (map (lambda (import-spec)
                               (apply resolve-interface import-spec))
                             imports)))
           (module-use-interfaces! module imports)))
       (module-re-export! module re-exports)
       ;; FIXME: Avoid use of `apply'.
       (apply module-autoload! module autoloads)
       (let ((duplicates (or duplicates
                             ;; Avoid stompling a previously installed
                             ;; duplicates handlers if possible.
                             (and (not (module-duplicates-handlers module))
                                  ;; Note: If you change this default,
                                  ;; change it also in
                                  ;; `default-duplicate-binding-procedures'.
                                  '(replace warn-override-core warn last)))))
         (when duplicates
           (let ((handlers (lookup-duplicates-handlers duplicates)))
             (set-module-duplicates-handlers! module handlers))))))

    (when transformer
      (unless (and (pair? transformer) (list-of symbol? transformer))
        (error "expected transformer to be a module name" transformer))
      (let ((iface (resolve-interface transformer))
            (sym (car (last-pair transformer))))
        (set-module-transformer! module (module-ref iface sym))))
    
    (run-hook module-defined-hook module)
    module))

;; `module-defined-hook' is a hook that is run whenever a new module
;; is defined.  Its members are called with one argument, the new
;; module.
(define module-defined-hook (make-hook 1))

