X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fmodule.lisp;h=83f129d716fdda520fffbe5239c6382a7217318b;hb=860543cc7ba0266e41e1d41ac9b6a208f3795f1a;hp=f7f3e5dcd6b905f0a47aa9ad6eb2d207e8f6bdf5;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/module.lisp b/src/code/module.lisp
index f7f3e5d..83f129d 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.
@@ -18,9 +14,6 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
-
-(file-comment
-  "$Header$")
 
 ;;;; exported specials
 
@@ -29,69 +22,56 @@
   "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."
+  (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))
+             ;; should we do this?  Probably can't hurt, while we're
+             ;; taking the above view of "load everything"...  though
+             ;; maybe having REQUIRE directly call PROVIDE is
+             ;; aesthetically suboptimal.
+	     (provide module-name))
+	    (t
+	     (unless (some (lambda (p) (funcall p module-name))
+			   sb!ext::*module-provider-functions*)
+	       (error "Don't know how to load ~A" module-name)))))
+    (set-difference *modules* saved-modules)))
 
 ;;;; 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))))
+    (load
+     (merge-pathnames (make-pathname :directory (list :relative filesys-name)
+				     :name filesys-name)
+		      (truename (posix-getenv "SBCL_HOME")))))
+  (provide name)
+  t)
+
+