/[cmucl]/src/code/module.lisp
ViewVC logotype

Contents of /src/code/module.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.17 - (show annotations)
Wed Jun 8 15:56:55 2011 UTC (2 years, 10 months ago) by rtoy
Branch: MAIN
CVS Tags: GIT-CONVERSION, snapshot-2011-09, snapshot-2011-07, HEAD
Changes since 1.16: +5 -1 lines
(require "asdf") loads asdf now.

This change need to support the new recommended way of loading asdf2
with require.  This is a backward compatible change.
1 ;;; -*- Log: code.log; Package: Lisp -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/module.lisp,v 1.17 2011/06/08 15:56:55 rtoy Exp $")
9 ;;;
10 ;;; **********************************************************************
11
12 ;;; Code written by Jim Muller.
13 ;;; Rewritten by Bill Chiles.
14 ;;;
15 ;;; Note that this module file is based on the old system, and is being
16 ;;; spliced into the current sources to reflect the last minute deprecated
17 ;;; addition of modules to the X3J13 ANSI standard.
18 ;;;
19 (in-package "LISP")
20 (intl:textdomain "cmucl")
21
22 (export '(*modules* provide require))
23
24
25 (in-package "EXTENSIONS")
26 (export '(*require-verbose* *module-provider-functions* defmodule))
27 (in-package "LISP")
28
29
30
31 ;;;; Exported specials.
32
33 (defvar *modules* ()
34 "This is a list of module names that have been loaded into Lisp so far.
35 It is used by PROVIDE and REQUIRE.")
36
37 (defvar *require-verbose* t
38 "*load-verbose* is bound to this before loading files.")
39
40 (defvar *module-provider-functions*
41 '(module-provide-cmucl-defmodule module-provide-cmucl-library)
42 "See function documentation for REQUIRE")
43
44 ;;;; Defmodule.
45
46 (defvar *module-file-translations* (make-hash-table :test #'equal))
47 (defmacro defmodule (name &rest files)
48 "Defines a module by registering the files that need to be loaded when
49 the module is required. If name is a symbol, its print name is used
50 after downcasing it."
51 `(%define-module ,name ',files))
52
53 (defun %define-module (name files)
54 (setf (gethash (module-name-string name) *module-file-translations*)
55 files))
56
57 (defun module-files (name)
58 (gethash name *module-file-translations*))
59
60
61
62 ;;;; Provide and Require.
63
64 (defun provide (module-name)
65 "Adds a new module name to *modules* indicating that it has been
66 loaded. Module-name may be any valid string designator. All
67 comparisons are done using string=, i.e. module names are
68 case-sensitive."
69 (pushnew (module-name-string module-name) *modules* :test #'string=)
70 t)
71
72 (defun require (module-name &optional pathname)
73 "Loads a module when it has not been already. Pathname, if
74 supplied, is a single pathname or list of pathnames to be loaded if
75 the module needs to be. If pathname is not supplied, then functions
76 from the list *MODULE-PROVIDER-FUNCTIONS* are called in order with
77 the stringified MODULE-NAME as the argument, until one of them
78 returns non-NIL. By default the functions
79 MODULE-PROVIDE-CMUCL-DEFMODULE and MODULE-PROVIDE- CMUCL-LIBRARY are
80 on this list of functions, in that order. The first of those looks
81 for a list of files that was registered by a EXT:DEFMODULE form. If
82 the module has not been defined, then the second function causes a
83 file to be loaded whose name is formed by merging \"modules:\" and
84 the concatenation of module-name with the suffix \"-LIBRARY\". Note
85 that both the module-name and the suffix are each, separately,
86 converted from :case :common to :case :local. This merged name will
87 be probed with both a .lisp and .fasl extensions, calling LOAD if it
88 exists.
89
90 Note that in all cases covered above, user code is responsible for
91 calling PROVIDE to indicate a successful load of the module.
92
93 While loading any files, *load-verbose* is bound to *require-verbose*
94 which defaults to t."
95 (let ((saved-modules (copy-list *modules*))
96 (module-name (module-name-string module-name)))
97 (unless (member module-name *modules* :test #'string=)
98 (let ((*load-verbose* *require-verbose*))
99 (if pathname
100 (dolist (file (if (consp pathname) pathname (list pathname)) t)
101 (load file))
102 (unless (some (lambda (p) (funcall p module-name))
103 *module-provider-functions*)
104 (error (intl:gettext "Don't know how to load ~A") module-name)))))
105 (set-difference *modules* saved-modules)))
106
107 ;;;; Default module providers
108 (defun module-provide-cmucl-defmodule (module-name)
109 (when (module-files module-name)
110 (dolist (file (module-files module-name) t)
111 (load file))))
112
113 (defun module-provide-cmucl-library (module-name)
114 (ext:without-package-locks
115 (load (module-default-pathname module-name) :if-does-not-exist nil)))
116
117
118 ;;;; Misc.
119
120 (defun module-name-string (name)
121 "Coerce a string designator to a module name."
122 (string name))
123
124 (defun module-default-pathname (module-name)
125 "Derive a default pathname to try to load for an undefined module
126 named module-name. The default pathname is constructed from the
127 module-name by appending the suffix \"-LIBRARY\" to it, and merging
128 with \"modules:\". Note that both the module-name and the suffix
129 are each, separately, converted from :case :common to :case :local."
130 (let* ((module-pathname (make-pathname :name module-name :case :common))
131 (library-pathname (make-pathname :name "-LIBRARY" :case :common)))
132 (merge-pathnames
133 "modules:"
134 (make-pathname :name
135 (concatenate 'string
136 (pathname-name module-pathname :case :local)
137 (pathname-name library-pathname :case :local))
138 :case :local))))
139
140 (defmodule :defsystem
141 "modules:defsystem/defsystem")
142
143 ;; Allow user to load asdf using either (require :asdf) or (require
144 ;; "asdf")
145 (defmodule :asdf
146 "modules:asdf/asdf")
147
148 (defmodule "asdf"
149 "modules:asdf/asdf")

  ViewVC Help
Powered by ViewVC 1.1.5