src/code/module.lisp

   1 ;;;; REQUIRE, PROVIDE, and friends
   2 ;;;;
   3 ;;;; Note that this module file is based on the old system, and is being
   4 ;;;; spliced into the current sources to reflect the last minute deprecated
   5 ;;;; addition of modules to the X3J13 ANSI standard.
   6 ;;;;
   7 ;;;; FIXME: This implementation has cruft not required by the ANSI
   8 ;;;; spec, notably DEFMODULE. We should probably minimize it, since
   9 ;;;; it's deprecated anyway.
  10
  11 ;;;; This software is part of the SBCL system. See the README file for
  12 ;;;; more information.
  13 ;;;;
  14 ;;;; This software is derived from the CMU CL system, which was
  15 ;;;; written at Carnegie Mellon University and released into the
  16 ;;;; public domain. The software is in the public domain and is
  17 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  18 ;;;; files for more information.
  19
  20 (in-package "SB!IMPL")
  21
  22 (file-comment
  23   "$Header$")
  24 \f
  25 ;;;; exported specials
  26
  27 (defvar *modules* ()
  28   #!+sb-doc
  29   "This is a list of module names that have been loaded into Lisp so far.
  30    It is used by PROVIDE and REQUIRE.")
  31
  32 ;;;; DEFMODULE
  33 ;;;; FIXME: Remove this.
  34
  35 (defvar *module-file-translations* (make-hash-table :test 'equal))
  36 (defmacro defmodule (name &rest files)
  37   #!+sb-doc
  38   "Defines a module by registering the files that need to be loaded when
  39    the module is required. If name is a symbol, its print name is used
  40    after downcasing it."
  41   `(%define-module ,name ',files))
  42
  43 (defun %define-module (name files)
  44   (setf (gethash (module-name-string name) *module-file-translations*)
  45         files))
  46
  47 (defun module-files (name)
  48   (gethash name *module-file-translations*))
  49 \f
  50 ;;;; PROVIDE and REQUIRE
  51
  52 (defun provide (module-name)
  53   #!+sb-doc
  54   "Adds a new module name to *MODULES* indicating that it has been loaded.
  55    Module-name may be either a case-sensitive string or a symbol; if it is
  56    a symbol, its print name is downcased and used."
  57   (pushnew (module-name-string module-name) *modules* :test #'string=)
  58   t)
  59
  60 (defun require (module-name &optional pathname)
  61   #!+sb-doc
  62   "Loads a module when it has not been already. PATHNAME, if supplied,
  63    is a single pathname or list of pathnames to be loaded if the module
  64    needs to be. If PATHNAME is not supplied, then a list of files are
  65    looked for that were registered by a DEFMODULE form. If the module
  66    has not been defined, then a file will be loaded whose name is formed
  67    by merging \"modules:\" and MODULE-NAME (downcased if it is a symbol).
  68    This merged name will be probed with both a .lisp extension and any
  69    architecture-specific FASL extensions, and LOAD will be called on it
  70    if it is found."
  71   ;; KLUDGE: Does this really match the doc string any more? (Did it ever
  72   ;; match the doc string? Arguably this isn't a high priority question
  73   ;; since REQUIRE is deprecated anyway and I've not been very motivated
  74   ;; to maintain CMU CL extensions like DEFMODULE.. -- WHN 19990804
  75   (setf module-name
  76         (module-name-string module-name))
  77   (unless (member module-name *modules* :test #'string=)
  78     (if pathname
  79       (unless (listp pathname) (setf pathname (list pathname)))
  80       (let ((files (module-files module-name)))
  81         (if files
  82           (setf pathname files)
  83           (setf pathname (list (merge-pathnames "modules:" module-name))))))
  84     (dolist (ele pathname t)
  85       (load ele))))
  86 \f
  87 ;;;; miscellany
  88
  89 (defun module-name-string (name)
  90   (typecase name
  91     (string name)
  92     (symbol (string-downcase (symbol-name name)))
  93     (t (error 'simple-type-error
  94               :datum name
  95               :expected-type '(or string symbol)
  96               :format-control "Module name must be a string or symbol -- ~S."
  97               :format-arguments (list name)))))