X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fmodule.lisp;h=77fe18b5b80149cc607d7fa3735f9ae4992d64d6;hb=2db3b6b4cb740d5b6512459c223859f747807b09;hp=59835d32fd051a785cbf32c7cb277fce6e4a4ef3;hpb=0b5610d8a220a4b20cbeac958953ca4d67c00038;p=sbcl.git

diff --git a/src/code/module.lisp b/src/code/module.lisp
index 59835d3..77fe18b 100644
--- a/src/code/module.lisp
+++ b/src/code/module.lisp
@@ -1,12 +1,8 @@
 ;;;; 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.
@@ -26,69 +22,49 @@
   "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))
+(defvar sb!ext::*MODULE-PROVIDER-FUNCTIONS* '(module-provide-contrib)
+  "See function documentation for REQUIRE")
 
-(defun module-files (name)
-  (gethash name *module-file-translations*))
 
 ;;;; 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."
+  (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))
+			 sb!ext::*module-provider-functions*)
+	     (error "Don't know how to load ~A" module-name))))))
+
 
 ;;;; 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 if it is a symbol, then attempt to load
+   the file $SBCL_HOME/name/name"
+  (let ((name (if (symbolp name) (string-downcase (symbol-name name)) name)))
+    (load
+     (merge-pathnames (make-pathname :directory (list :relative name)
+				     :name name)
+		      (truename (posix-getenv "SBCL_HOME")))))
+  (provide name))
+
+