Skip to content
Snippets Groups Projects
Commit d71d9d0b authored by pmai's avatar pmai
Browse files

Port of the *module-provider-functions* extension to cl:require from SBCL.

The old defmodule handler and the module:*-library.* loading have been
factored out to their own module-provider functions, which are by default
on *module-provider-functions*.  Note however that this implies one
functional change for defmodule defined modules:  The loading of the files
constituting such a module are now _NOT_ wrapped with without-package-locks.

Wrapping of module:*-library.* files with without-package-locks is only
retained temporarily, until proper changes to the various modules have
been made.

Also adjusted documentation of require to correctly state the default for
*require-verbose* which has always been t, not nil as previously claimed.

This change is still missing documentation in the user manual.
parent 2d50bf26
No related branches found
No related tags found
No related merge requests found
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.232 2004/06/01 23:10:55 cwang Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.233 2004/06/20 17:43:28 pmai Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -1181,7 +1181,7 @@
"*KEYWORD-PACKAGE*" "*LISP-PACKAGE*" "*LOAD-IF-SOURCE-NEWER*"
"*MAX-OLD-TRACE-INDENTATION*" "*MAX-STEP-INDENTATION*"
"*MAX-TRACE-INDENTATION*" "*MODULE-FILE-TRANSLATIONS*"
"*PROMPT*" "*REQUIRE-VERBOSE*"
"*PROMPT*" "*REQUIRE-VERBOSE*" "*MODULE-PROVIDER-FUNCTIONS*"
"*SETF-FDEFINITION-HOOK*"
"*TOP-LEVEL-AUTO-DECLARE*"
"COMPILER-MACROEXPAND-1" "COMPILER-MACROEXPAND"
......
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/module.lisp,v 1.8 2003/05/12 16:30:41 emarsden Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/module.lisp,v 1.9 2004/06/20 17:43:28 pmai Exp $")
;;;
;;; **********************************************************************
......@@ -22,7 +22,7 @@
(in-package "EXTENSIONS")
(export '(*require-verbose* defmodule))
(export '(*require-verbose* *module-provider-functions* defmodule))
(in-package "LISP")
......@@ -36,6 +36,10 @@
(defvar *require-verbose* t
"*load-verbose* is bound to this before loading files.")
(defvar *module-provider-functions*
'(module-provide-cmucl-defmodule module-provide-cmucl-library)
"See function documentation for REQUIRE")
;;;; Defmodule.
(defvar *module-file-translations* (make-hash-table :test #'equal))
......@@ -66,26 +70,46 @@
(defun require (module-name &optional pathname)
"Loads a module when it has not been already. Pathname, if supplied,
is a single pathname or list of pathnames to be loaded if the module
needs to be. If pathname is not supplied, then a list of files are
looked for that were registered by a EXT:DEFMODULE form. If the module
has not been defined, then a file will be loaded whose name is formed
by merging \"modules:\" and the concatenation of module-name with the
suffix \"-LIBRARY\". Note that both the module-name and the suffix are
each, separately, converted from :case :common to :case :local. This
merged name will be probed with both a .lisp and .fasl extensions,
calling LOAD if it exists. While loading any files, *load-verbose* is
bound to *require-verbose* which defaults to nil."
(setf module-name (module-name-string module-name))
(unless (member module-name *modules* :test #'string=)
(let ((files (or (when pathname
(if (consp pathname) pathname (list pathname)))
(module-files module-name)
(list (module-default-pathname module-name))))
(*load-verbose* *require-verbose*))
(dolist (file files t)
(ext:without-package-locks
(load file))))))
needs to be. If pathname is not supplied, then functions from the list
*MODULE-PROVIDER-FUNCTIONS* are called in order with the stringified
MODULE-NAME as the argument, until one of them returns non-NIL. By
default the functions MODULE-PROVIDE-CMUCL-DEFMODULE and MODULE-PROVIDE-
CMUCL-LIBRARY are on this list of functions, in that order. The first
of those looks for a list of files that was registered by a EXT:DEFMODULE
form. If the module has not been defined, then the second function
causes a file to be loaded whose name is formed by merging \"modules:\"
and the concatenation of module-name with the suffix \"-LIBRARY\".
Note that both the module-name and the suffix are each, separately,
converted from :case :common to :case :local. This merged name will be
probed with both a .lisp and .fasl extensions, calling LOAD if it exists.
Note that in all cases covered above, user code is responsible for
calling PROVIDE to indicate a successful load of the module.
While loading any files, *load-verbose* is bound to *require-verbose*
which defaults to t."
(let ((saved-modules (copy-list *modules*))
(module-name (module-name-string module-name)))
(unless (member module-name *modules* :test #'string=)
(let ((*load-verbose* *require-verbose*))
(if pathname
(dolist (file (if (consp pathname) pathname (list pathname)) t)
(ext:without-package-locks
(load file)))
(unless (some (lambda (p) (funcall p module-name))
*module-provider-functions*)
(error "Don't know how to load ~A" module-name)))))
(set-difference *modules* saved-modules)))
;;;; Default module providers
(defun module-provide-cmucl-defmodule (module-name)
(when (module-files module-name)
(dolist (file (module-files module-name) t)
(load file))))
(defun module-provide-cmucl-library (module-name)
(ext:without-package-locks
(load (module-default-pathname module-name) :if-does-not-exist nil)))
;;;; Misc.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment