;;;; REQUIRE, PROVIDE, and friends
;;;;
-;;;; Note that this module file is based on the old system, and is being
-;;;; spliced into the current sources to reflect the last minute deprecated
-;;;; addition of modules to the X3J13 ANSI standard.
-;;;;
-;;;; FIXME: This implementation has cruft not required by the ANSI
-;;;; spec, notably DEFMODULE. We should probably minimize it, since
-;;;; it's deprecated anyway.
+;;;; Officially these are deprecated, but in practice they're probably
+;;;; even less likely to actually go away than there is to ever be
+;;;; another revision of the standard.
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
"This is a list of module names that have been loaded into Lisp so far.
It is used by PROVIDE and REQUIRE.")
-;;;; DEFMODULE
-;;;; FIXME: Remove this.
-
-(defvar *module-file-translations* (make-hash-table :test 'equal))
-(defmacro defmodule (name &rest files)
- #!+sb-doc
- "Defines a module by registering the files that need to be loaded when
- the module is required. If name is a symbol, its print name is used
- after downcasing it."
- `(%define-module ,name ',files))
-
-(defun %define-module (name files)
- (setf (gethash (module-name-string name) *module-file-translations*)
- files))
-
-(defun module-files (name)
- (gethash name *module-file-translations*))
+(defvar *module-provider-functions* '(module-provide-contrib)
+ "See function documentation for REQUIRE")
\f
;;;; PROVIDE and REQUIRE
(defun provide (module-name)
#!+sb-doc
"Adds a new module name to *MODULES* indicating that it has been loaded.
- Module-name may be either a case-sensitive string or a symbol; if it is
- a symbol, its print name is downcased and used."
- (pushnew (module-name-string module-name) *modules* :test #'string=)
+ Module-name is a string designator"
+ (pushnew (string module-name) *modules* :test #'string=)
t)
-(defun require (module-name &optional pathname)
+(defun require (module-name &optional pathnames)
#!+sb-doc
- "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 DEFMODULE form. If the module
- has not been defined, then a file will be loaded whose name is formed
- by merging \"modules:\" and MODULE-NAME (downcased if it is a symbol).
- This merged name will be probed with both a .lisp extension and any
- architecture-specific FASL extensions, and LOAD will be called on it
- if it is found."
- ;; KLUDGE: Does this really match the doc string any more? (Did it ever
- ;; match the doc string? Arguably this isn't a high priority question
- ;; since REQUIRE is deprecated anyway and I've not been very motivated
- ;; to maintain CMU CL extensions like DEFMODULE.. -- WHN 19990804
- (setf module-name
- (module-name-string module-name))
- (unless (member module-name *modules* :test #'string=)
- (if pathname
- (unless (listp pathname) (setf pathname (list pathname)))
- (let ((files (module-files module-name)))
- (if files
- (setf pathname files)
- (setf pathname (list (merge-pathnames "modules:" module-name))))))
- (dolist (ele pathname t)
- (load ele))))
+ "Loads a module, unless it already has been loaded. PATHNAMES, if supplied,
+ is a designator for a list of pathnames to be loaded if the module
+ needs to be. If PATHNAMES is not supplied, functions from the list
+ *MODULE-PROVIDER-FUNCTIONS* are called in order with MODULE-NAME
+ as an argument, until one of them returns non-NIL. User code is
+ responsible for calling PROVIDE to indicate a successful load of the
+ module."
+ (let ((saved-modules (copy-list *modules*)))
+ (unless (member (string module-name) *modules* :test #'string=)
+ (cond (pathnames
+ (unless (listp pathnames) (setf pathnames (list pathnames)))
+ ;; ambiguity in standard: should we try all pathnames in the
+ ;; list, or should we stop as soon as one of them calls PROVIDE?
+ (dolist (ele pathnames t)
+ (load ele)))
+ (t
+ (unless (some (lambda (p) (funcall p module-name))
+ *module-provider-functions*)
+ (error 'extension-failure
+ :format-control "Don't know how to ~S ~A"
+ :format-arguments (list 'require module-name)
+ :references
+ (list
+ '(:sbcl :variable *module-provider-functions*)))))))
+ (set-difference *modules* saved-modules)))
\f
;;;; miscellany
-(defun module-name-string (name)
- (typecase name
- (string name)
- (symbol (string-downcase (symbol-name name)))
- (t (error 'simple-type-error
- :datum name
- :expected-type '(or string symbol)
- :format-control "Module name must be a string or symbol: ~S"
- :format-arguments (list name)))))
+(defun module-provide-contrib (name)
+ "Stringify and downcase NAME, then attempt to load the file
+ $SBCL_HOME/name/name"
+ (let* ((filesys-name (string-downcase (string name)))
+ (unadorned-path
+ (merge-pathnames
+ (make-pathname :directory (list :relative filesys-name)
+ :name filesys-name)
+ (truename (posix-getenv "SBCL_HOME"))))
+ (fasl-path (merge-pathnames
+ (make-pathname :type *fasl-file-type*)
+ unadorned-path))
+ (lisp-path (merge-pathnames (make-pathname :type "lisp")
+ unadorned-path)))
+ ;; KLUDGE: there's a race condition here; the file we probe could
+ ;; be removed by the time we get round to trying to load it.
+ ;; Maybe factor out the logic in the LOAD guesser as to which file
+ ;; was meant, so that we can use it here on open streams instead?
+ (when (or (probe-file unadorned-path)
+ (probe-file fasl-path)
+ (probe-file lisp-path))
+ (load unadorned-path)
+ t)))
projects / sbcl.git / blobdiff