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 \f
  22 ;;;; exported specials
  23
  24 (defvar *modules* ()
  25   #!+sb-doc
  26   "This is a list of module names that have been loaded into Lisp so far.
  27    It is used by PROVIDE and REQUIRE.")
  28
  29 ;;;; DEFMODULE
  30 ;;;; FIXME: Remove this.
  31
  32 (defvar *module-file-translations* (make-hash-table :test 'equal))
  33 (defmacro defmodule (name &rest files)
  34   #!+sb-doc
  35   "Defines a module by registering the files that need to be loaded when
  36    the module is required. If name is a symbol, its print name is used
  37    after downcasing it."
  38   `(%define-module ,name ',files))
  39
  40 (defun %define-module (name files)
  41   (setf (gethash (module-name-string name) *module-file-translations*)
  42         files))
  43
  44 (defun module-files (name)
  45   (gethash name *module-file-translations*))
  46 \f
  47 ;;;; PROVIDE and REQUIRE
  48
  49 (defun provide (module-name)
  50   #!+sb-doc
  51   "Adds a new module name to *MODULES* indicating that it has been loaded.
  52    Module-name may be either a case-sensitive string or a symbol; if it is
  53    a symbol, its print name is downcased and used."
  54   (pushnew (module-name-string module-name) *modules* :test #'string=)
  55   t)
  56
  57 (defun require (module-name &optional pathname)
  58   #!+sb-doc
  59   "Loads a module when it has not been already. PATHNAME, if supplied,
  60    is a single pathname or list of pathnames to be loaded if the module
  61    needs to be. If PATHNAME is not supplied, then a list of files are
  62    looked for that were registered by a DEFMODULE form. If the module
  63    has not been defined, then a file will be loaded whose name is formed
  64    by merging \"modules:\" and MODULE-NAME (downcased if it is a symbol).
  65    This merged name will be probed with both a .lisp extension and any
  66    architecture-specific FASL extensions, and LOAD will be called on it
  67    if it is found."
  68   ;; KLUDGE: Does this really match the doc string any more? (Did it ever
  69   ;; match the doc string? Arguably this isn't a high priority question
  70   ;; since REQUIRE is deprecated anyway and I've not been very motivated
  71   ;; to maintain CMU CL extensions like DEFMODULE.. -- WHN 19990804
  72   (setf module-name
  73         (module-name-string module-name))
  74   (unless (member module-name *modules* :test #'string=)
  75     (if pathname
  76       (unless (listp pathname) (setf pathname (list pathname)))
  77       (let ((files (module-files module-name)))
  78         (if files
  79           (setf pathname files)
  80           (setf pathname (list (merge-pathnames "modules:" module-name))))))
  81     (dolist (ele pathname t)
  82       (load ele))))
  83 \f
  84 ;;;; miscellany
  85
  86 (defun module-name-string (name)
  87   (typecase name
  88     (string name)
  89     (symbol (string-downcase (symbol-name name)))
  90     (t (error 'simple-type-error
  91               :datum name
  92               :expected-type '(or string symbol)
  93               :format-control "Module name must be a string or symbol: ~S"
  94               :format-arguments (list name)))))