;;; -*- Mode: Lisp; Package: make -*-
;;; -*- Mode: CLtL; Syntax: Common-Lisp -*-

;;; DEFSYSTEM 3.6 Interim.

;;; defsystem.lisp --

;;; ****************************************************************
;;; MAKE -- A Portable Defsystem Implementation ********************
;;; ****************************************************************

;;; This is a portable system definition facility for Common Lisp.

;;; Though home-grown, the syntax was inspired by fond memories of the
;;; defsystem facility on Symbolics 3600's. The exhaustive lists of
;;; filename extensions for various lisps and the idea to have one
;;; "operate-on-system" function instead of separate "compile-system"

;;; and "load-system" functions were taken from Xerox Corp.'s PCL

;;; system.

;;; This system improves on both PCL and Symbolics defsystem utilities

;;; by performing a topological sort of the graph of file-dependency

;;; constraints. Thus, the components of the system need not be listed
;;; in any special order, because the defsystem command reorganizes them
;;; based on their constraints. It includes all the standard bells and
;;; whistles, such as not recompiling a binary file that is up to date
;;; (unless the user specifies that all files should be recompiled).

;;; Originally written by Mark Kantrowitz, School of Computer Science,

;;; Carnegie Mellon University, October 1989.

;;; MK:DEFSYSTEM 3.6 Interim
;;;
;;; Copyright (c) 1989 - 1999 Mark Kantrowitz. All rights reserved.
;;;               1999 - 2005 Mark Kantrowitz and Marco Antoniotti. All
;;;                           rights reserved.

;;; Use, copying, modification, merging, publishing, distribution
;;; and/or sale of this software, source and/or binary files and
;;; associated documentation files (the "Software") and of derivative
;;; works based upon this Software are permitted, as long as the
;;; following conditions are met:

;;;    o this copyright notice is included intact and is prominently
;;;      visible in the Software
;;;    o if modifications have been made to the source code of the
;;;      this package that have not been adopted for inclusion in the
;;;      official version of the Software as maintained by the Copyright
;;;      holders, then the modified package MUST CLEARLY identify that
;;;      such package is a non-standard and non-official version of
;;;      the Software.  Furthermore, it is strongly encouraged that any
;;;      modifications made to the Software be sent via e-mail to the
;;;      MK-DEFSYSTEM maintainers for consideration of inclusion in the
;;;      official MK-DEFSYSTEM package.

;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT.
;;; IN NO EVENT SHALL M. KANTROWITZ AND M. ANTONIOTTI BE LIABLE FOR ANY
;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

;;; Except as contained in this notice, the names of M. Kantrowitz and
;;; M. Antoniotti shall not be used in advertising or otherwise to promote
;;; the sale, use or other dealings in this Software without prior written
;;; authorization from M. Kantrowitz and M. Antoniotti.


;;; Please send bug reports, comments and suggestions to <marcoxa@cons.org>.


;;; ********************************
;;; Change Log *********************
;;; ********************************
;;;
;;; Note: Several of the fixes from 30-JAN-91 and 31-JAN-91 were done in

;;; September and October 1990, but not documented until January 1991.

;;;
;;; akd  = Abdel Kader Diagne <diagne@dfki.uni-sb.de>
;;; as   = Andreas Stolcke <stolcke@ICSI.Berkeley.EDU>
;;; bha  = Brian Anderson <bha@atc.boeing.com>
;;; brad = Brad Miller <miller@cs.rochester.edu>
;;; bw   = Robert Wilhelm <wilhelm@rpal.rockwell.com>
;;; djc  = Daniel J. Clancy <clancy@cs.utexas.edu>
;;; fdmm = Fernando D. Mato Mira <matomira@di.epfl.ch>
;;; gc   = Guillaume Cartier <cartier@math.uqam.ca>
;;; gi   = Gabriel Inaebnit <inaebnit@research.abb.ch>
;;; gpw  = George Williams <george@hsvaic.boeing.com>
;;; hkt  = Rick Taube <hkt@cm-next-8.stanford.edu>
;;; ik   = Ik Su Yoo <ik@ctt.bellcore.com>
;;; jk   = John_Kolojejchick@MORK.CIMDS.RI.CMU.EDU
;;; kt   = Kevin Thompson <kthompso@ptolemy.arc.nasa.gov>
;;; kc   = Kaelin Colclasure <kaelin@bridge.com>

;;; kmr  = Kevin M. Rosenberg <kevin@rosenberg.net>

;;; lmh  = Liam M. Healy <Liam.Healy@nrl.navy.mil>
;;; mc   = Matthew Cornell <cornell@unix1.cs.umass.edu>
;;; oc   = Oliver Christ <oli@adler.ims.uni-stuttgart.de>
;;; rs   = Ralph P. Sobek <ralph@vega.laas.fr>
;;; rs2  = Richard Segal <segal@cs.washington.edu>
;;; sb   = Sean Boisen <sboisen@bbn.com>
;;; ss   = Steve Strassman <straz@cambridge.apple.com>
;;; tar  = Thomas A. Russ <tar@isi.edu>
;;; toni = Anton Beschta <toni%l4@ztivax.siemens.com>
;;; yc   = Yang Chen <yangchen%iris.usc.edu@usc.edu>
;;;
;;; Thanks to Steve Strassmann <straz@media-lab.media.mit.edu> and

;;; Sean Boisen <sboisen@BBN.COM> for detailed bug reports and

;;; miscellaneous assistance. Thanks also to Gabriel Inaebnit
;;; <inaebnit@research.abb.ch> for help with VAXLisp bugs.
;;;
;;; 05-NOV-90  hkt  Changed canonicalize-system-name to make system
;;;                 names package independent. Interns them in the
;;;                 keyword package. Thus either strings or symbols may
;;;                 be used to name systems from the user's point of view.
;;; 05-NOV-90  hkt  Added definition FIND-SYSTEM to allow OOS to
;;;                 work on systems whose definition hasn't been loaded yet.
;;; 05-NOV-90  hkt  Added definitions COMPILE-SYSTEM and LOAD-SYSTEM
;;;                 as alternates to OOS for naive users.
;;; 05-NOV-90  hkt  Shadowing-import of 'defsystem in Allegro CL 3.1 [NeXT]
;;;                 into USER package instead of import.
;;; 15-NOV-90  mk   Changed package name to "MAKE", eliminating "DEFSYSTEM"
;;;                 to avoid conflicts with allegro, symbolics packages
;;;                 named "DEFSYSTEM".

;;; 30-JAN-91  mk   Modified append-directories to work with the

;;;                 logical-pathnames system.
;;; 30-JAN-91  mk   Append-directories now works with Sun CL4.0. Also, fixed
;;;                 bug wrt Lucid 4.0's pathnames (which changed from lcl3.0
;;;                 -- 4.0 uses a list for the directory slot, whereas
;;;                 3.0 required a string). Possible fix to symbolics bug.
;;; 30-JAN-91  mk   Defined NEW-REQUIRE to make redefinition of REQUIRE
;;;                 cleaner. Replaced all calls to REQUIRE in this file with
;;;                 calls to NEW-REQUIRE, which should avoid compiler warnings.
;;; 30-JAN-91  mk   In VAXLisp, when we redefine lisp:require, the compiler
;;;                 no longer automatically executes require forms when it
;;;                 encounters them in a file. The user can always wrap an
;;;                 (eval-when (compile load eval) ...) around the require
;;;                 form. Alternately, see commented out code near the
;;;                 redefinition of lisp:require which redefines it as a
;;;                 macro instead.
;;; 30-JAN-91  mk   Added parameter :version to operate-on-system. If it is
;;;                 a number, that number is used as part of the binary
;;;                 directory name as the place to store and load files.
;;;                 If NIL (the default), uses regular binary directory.
;;;                 If T, tries to find the most recent version of the
;;;                 binary directory.
;;; 30-JAN-91  mk   Added global variable *use-timeouts* (default: t), which
;;;                 specifies whether timeouts should be used in
;;;                 Y-OR-N-P-WAIT. This is provided for users whose lisps
;;;                 don't handle read-char-no-hang properly, so that they
;;;                 can set it to NIL to disable the timeouts. Usually the
;;;                 reason for this is the lisp is run on top of UNIX,
;;;                 which buffers input LINES (and provides input editing).
;;;                 To get around this we could always turn CBREAK mode
;;;                 on and off, but there's no way to do this in a portable
;;;                 manner.
;;; 30-JAN-91  mk   Fixed bug where in :test t mode it was actually providing
;;;                 the system, instead of faking it.
;;; 30-JAN-91  mk   Changed storage of system definitions to a hash table.
;;;                 Changed canonicalize-system-name to coerce the system
;;;                 names to uppercase strings. Since we're no longer using
;;;                 get, there's no need to intern the names as symbols,
;;;                 and strings don't have packages to cause problems.
;;;                 Added UNDEFSYSTEM, DEFINED-SYSTEMS, and DESCRIBE-SYSTEM.

;;;                 Added :delete-binaries command.

;;; 31-JAN-91  mk   Franz Allegro CL has a defsystem in the USER package,
;;;                 so we need to do a shadowing import to avoid name
;;;                 conflicts.
;;; 31-JAN-91  mk   Fixed bug in compile-and-load-operation where it was
;;;                 only loading newly compiled files.
;;; 31-JAN-91  mk   Added :load-time slot to components to record the
;;;                 file-write-date of the binary/source file that was loaded.
;;;                 Now knows "when" (which date version) the file was loaded.
;;;                 Added keyword :minimal-load and global *minimal-load*
;;;                 to enable defsystem to avoid reloading unmodified files.
;;;                 Note that if B depends on A, but A is up to date and
;;;                 loaded and the user specified :minimal-load T, then A
;;;                 will not be loaded even if B needs to be compiled. So
;;;                 if A is an initializations file, say, then the user should
;;;                 not specify :minimal-load T.
;;; 31-JAN-91  mk   Added :load-only slot to components. If this slot is
;;;                 specified as non-NIL, skips over any attempts to compile
;;;                 the files in the component. (Loading the file satisfies
;;;                 the need to recompile.)
;;; 31-JAN-91  mk   Eliminated use of set-alist-lookup and alist-lookup,
;;;                 replacing it with hash tables. It was too much bother,
;;;                 and rather brittle too.
;;; 31-JAN-91  mk   Defined #@ macro character for use with AFS @sys
;;;                 feature simulator. #@"directory" is then synonymous
;;;                 with (afs-binary-directory "directory").
;;; 31-JAN-91  mk   Added :private-file type of module. It is similar to
;;;                 :file, but has an absolute pathname. This allows you
;;;                 to specify a different version of a file in a system
;;;                 (e.g., if you're working on the file in your home
;;;                 directory) without completely rewriting the system
;;;                 definition.
;;; 31-JAN-91  mk   Operations on systems, such as :compile and :load,
;;;                 now propagate to subsystems the system depends on
;;;                 if *operations-propagate-to-subsystems* is T (the default)
;;;                 and the systems were defined using either defsystem
;;;                 or as a :system component of another system. Thus if

;;;                 a system depends on another, it can now recompile the

;;;                 other.
;;; 01-FEB-91  mk   Added default definitions of PROVIDE/REQUIRE/*MODULES*
;;;                 for lisps that have thrown away these definitions in
;;;                 accordance with CLtL2.
;;; 01-FEB-91  mk   Added :compile-only slot to components. Analogous to
;;;                 :load-only. If :compile-only is T, will not load the
;;;                 file on operation :compile. Either compiles or loads
;;;                 the file, but not both. In other words, compiling the
;;;                 file satisfies the demand to load it. This is useful

;;;                 for PCL defmethod and defclass definitions, which wrap

;;;                 an (eval-when (compile load eval) ...) around the body
;;;                 of the definition -- we save time by not loading the
;;;                 compiled code, since the eval-when forces it to be
;;;                 loaded. Note that this may not be entirely safe, since
;;;                 CLtL2 has added a :load keyword to compile-file, and
;;;                 some lisps may maintain a separate environment for
;;;                 the compiler. This feature is for the person who asked
;;;                 that a :COMPILE-SATISFIES-LOAD keyword be added to

;;;                 modules. It's named :COMPILE-ONLY instead to match

;;;                 :LOAD-ONLY.
;;; 11-FEB-91  mk   Now adds :mk-defsystem to features list, to allow
;;;                 special cased loading of defsystem if not already
;;;                 present.
;;; 19-FEB-91  duff Added filename extension for hp9000/300's running Lucid.
;;; 26-FEB-91  mk   Distinguish between toplevel systems (defined with
;;;                 defsystem) and systems defined as a :system module
;;;                 of a defsystem. The former can depend only on systems,
;;;                 while the latter can depend on anything at the same
;;;                 level.
;;; 12-MAR-91  mk   Added :subsystem component type to be a system with
;;;                 pathnames relative to its parent component.
;;; 12-MAR-91  mk   Uncommented :device :absolute for CMU pathnames, so
;;;                 that the leading slash is included.

;;; 12-MAR-91  brad Patches for Allegro 4.0.1 on Sparc.

;;; 12-MAR-91  mk   Changed definition of format-justified-string so that
;;;                 it no longer depends on the ~<~> format directives,
;;;                 because Allegro 4.0.1 has a bug which doesn't support
;;;                 them. Anyway, the new definition is twice as fast
;;;                 and conses half as much as FORMAT.
;;; 12-MAR-91 toni  Remove nils from list in expand-component-components.
;;; 12-MAR-91 bw    If the default-package and system have the same name,
;;;                 and the package is not loaded, this could lead to
;;;                 infinite loops, so we bomb out with an error.
;;;                 Fixed bug in default packages.
;;; 13-MAR-91 mk    Added global *providing-blocks-load-propagation* to
;;;                 control whether system dependencies are loaded if they
;;;                 have already been provided.
;;; 13-MAR-91 brad  In-package is a macro in CLtL2 lisps, so we change
;;;                 the package manually in operate-on-component.
;;; 15-MAR-91 mk    Modified *central-registry* to be either a single
;;;                 directory pathname, or a list of directory pathnames
;;;                 to be checked in order.
;;; 15-MAR-91 rs    Added afs-source-directory to handle versions when
;;;                 compiling C code under lisp. Other minor changes to
;;;                 translate-version and operate-on-system.

;;; 21-MAR-91 gi    Fixed bug in defined-systems.

;;; 22-MAR-91 mk    Replaced append-directories with new version that works
;;;                 by actually appending the directories, after massaging
;;;                 them into the proper format. This should work for all
;;;                 CLtL2-compliant lisps.
;;; 09-APR-91 djc   Missing package prefix for lp:pathname-host-type.
;;;                 Modified component-full-pathname to work for logical
;;;                 pathnames.
;;; 09-APR-91 mk    Added *dont-redefine-require* to control whether
;;;                 REQUIRE is redefined. Fixed minor bugs in redefinition
;;;                 of require.
;;; 12-APR-91 mk    (pathname-host nil) causes an error in MCL 2.0b1
;;; 12-APR-91 mc    Ported to MCL2.0b1.
;;; 16-APR-91 mk    Fixed bug in needs-loading where load-time and
;;;                 file-write-date got swapped.
;;; 16-APR-91 mk    If the component is load-only, defsystem shouldn't
;;;                 tell you that there is no binary and ask you if you

;;;                 want to load the source.

;;; 17-APR-91 mc    Two additional operations for MCL.
;;; 21-APR-91 mk    Added feature requested by ik. *files-missing-is-an-error*
;;;                 new global variable which controls whether files (source
;;;                 and binary) missing cause a continuable error or just a
;;;                 warning.
;;; 21-APR-91 mk    Modified load-file-operation to allow compilation of source
;;;                 files during load if the binary files are old or
;;;                 non-existent. This adds a :compile-during-load keyword to
;;;                 oos, and load-system. Global *compile-during-load* sets
;;;                 the default (currently :query).
;;; 21-APR-91 mk    Modified find-system so that there is a preference for
;;;                 loading system files from disk, even if the system is
;;;                 already defined in the environment.
;;; 25-APR-91 mk    Removed load-time slot from component defstruct and added
;;;                 function COMPONENT-LOAD-TIME to store the load times in a
;;;                 hash table. This is safer than the old definition because
;;;                 it doesn't wipe out load times every time the system is
;;;                 redefined.
;;; 25-APR-91 mk    Completely rewrote load-file-operation. Fixed some bugs
;;;                 in :compile-during-load and in the behavior of defsystem
;;;                 when multiple users are compiling and loading a system
;;;                 instead of just a single user.
;;; 16-MAY-91 mk    Modified FIND-SYSTEM to do the right thing if the system
;;;                 definition file cannot be found.
;;; 16-MAY-91 mk    Added globals *source-pathname-default* and
;;;                 *binary-pathname-default* to contain default values for
;;;                 :source-pathname and :binary-pathname. For example, set
;;;                 *source-pathname-default* to "" to avoid having to type
;;;                 :source-pathname "" all the time.
;;; 27-MAY-91 mk    Fixed bug in new-append-directories where directory
;;;                 components of the form "foo4.0" would appear as "foo4",
;;;                 since pathname-name truncates the type. Changed
;;;                 pathname-name to file-namestring.
;;;  3-JUN-91 gc    Small bug in new-append-directories; replace (when
;;;                 abs-name) with (when (not (null-string abs-name)))
;;;  4-JUN-91 mk    Additional small change to new-append-directories for
;;;                 getting the device from the relative pname if the abs
;;;                 pname is "". This is to fix a small behavior in CMU CL old
;;;                 compiler. Also changed (when (not (null-string abs-name)))
;;;                 to have an (and abs-name) in there.
;;;  8-JAN-92 sb    Added filename extension for defsystem under Lucid Common
;;;                 Lisp/SGO 3.0.1+.
;;;  8-JAN-92 mk    Changed the definition of prompt-string to work around an
;;;                 AKCL bug. Essentially, AKCL doesn't default the colinc to
;;;                 1 if the colnum is provided, so we hard code it.
;;;  8-JAN-92 rs    (pathname-directory (pathname "")) returns '(:relative) in
;;;                 Lucid, instead of NIL. Changed new-append-directories and
;;;                 test-new-append-directories to reflect this.
;;;  8-JAN-92 mk    Fixed problem related to *load-source-if-no-binary*.
;;;                 compile-and-load-source-if-no-binary wasn't checking for
;;;                 the existence of the binary if this variable was true,
;;;                 causing the file to not be compiled.
;;;  8-JAN-92 mk    Fixed problem with null-string being called on a pathname
;;;                 by returning NIL if the argument isn't a string.
;;;  3-NOV-93 mk    In Allegro 4.2, pathname device is :unspecific by default.
;;; 11-NOV-93 fdmm  Fixed package definition lock problem when redefining

;;;                 REQUIRE on ACL.

;;; 11-NOV-93 fdmm  Added machine and software types for SGI and IRIX. It is
;;;                 important to distinguish the OS version and CPU type in
;;;                 SGI+ACL, since ACL 4.1 on IRIX 4.x and ACL 4.2 on IRIX 5.x
;;;                 have incompatible .fasl files.
;;; 01-APR-94 fdmm  Fixed warning problem when redefining REQUIRE on LispWorks.
;;; 01-NOV-94 fdmm  Replaced (software-type) call in ACL by code extracting
;;;                 the interesting parts from (software-version) [deleted
;;;                 machine name and id].
;;; 03-NOV-94 fdmm  Added a hook (*compile-file-function*), that is funcalled
;;;                 by compile-file-operation, so as to support other languages
;;;                 running on top of Common Lisp.
;;;                 The default is to compile  Common Lisp.
;;; 03-NOV-94 fdmm  Added SCHEME-COMPILE-FILE, so that defsystem can now
;;;                 compile Pseudoscheme files.
;;; 04-NOV-94 fdmm  Added the exported generic function SET-LANGUAGE, to

;;;                 have a clean, easy to extend  interface for telling
;;;                 defsystem which language to assume for compilation.

;;;                 Currently supported arguments: :common-lisp, :scheme.
;;; 11-NOV-94 kc    Ported to Allegro CL for Windows 2.0 (ACLPC) and CLISP.
;;; 18-NOV-94 fdmm  Changed the entry *filename-extensions* for LispWorks
;;;                 to support any platform.
;;;                 Added entries for :mcl and :clisp too.
;;; 16-DEC-94 fdmm  Added and entry for CMU CL on SGI to *filename-extensions*.
;;; 16-DEC-94 fdmm  Added OS version identification for CMU CL on SGI.

;;; 16-DEC-94 fdmm  For CMU CL 17 : Bypassed make-pathnames call fix

;;;                 in NEW-APPEND-DIRECTORIES.

;;; 16-DEC-94 fdmm  Added HOME-SUBDIRECTORY to fix CMU's ignorance about `~'

;;;                 when specifying registries.
;;; 16-DEC-94 fdmm  For CMU CL 17 : Bypassed :device fix in make-pathnames call
;;;                 in COMPONENT-FULL-PATHNAME. This fix was also reported
;;;                 by kc on 12-NOV-94. CMU CL 17 now supports CLtL2 pathnames.
;;; 16-DEC-94 fdmm  Removed a quote before the call to read in the readmacro
;;;                 #@. This fixes a really annoying misfeature (couldn't do
;;;                 #@(concatenate 'string "foo/" "bar"), for example).
;;; 03-JAN-95 fdmm  Do not include :pcl in *features* if :clos is there.
;;;  2-MAR-95 mk    Modified fdmm's *central-registry* change to use
;;;                 user-homedir-pathname and to be a bit more generic in the

;;;                 pathnames.

;;;  2-MAR-95 mk    Modified fdmm's updates to *filename-extensions* to handle
;;;                 any CMU CL binary extensions.
;;;  2-MAR-95 mk    Make kc's port to ACLPC a little more generic.
;;;  2-MAR-95 mk    djc reported a bug, in which GET-SYSTEM was not returning
;;;                 a system despite the system's just having been loaded.

;;;                 The system name specified in the :depends-on was a

;;;                 lowercase string. I am assuming that the system name
;;;                 in the defsystem form was a symbol (I haven't verified
;;;                 that this was the case with djc, but it is the only
;;;                 reasonable conclusion). So, CANONICALIZE-SYSTEM-NAME
;;;                 was storing the system in the hash table as an
;;;                 uppercase string, but attempting to retrieve it as a
;;;                 lowercase string. This behavior actually isn't a bug,

;;;                 but a user error. It was intended as a feature to

;;;                 allow users to use strings for system names when
;;;                 they wanted to distinguish between two different systems
;;;                 named "foo.system" and "Foo.system". However, this
;;;                 user error indicates that this was a bad design decision.
;;;                 Accordingly, CANONICALIZE-SYSTEM-NAME now uppercases
;;;                 even strings for retrieving systems, and the comparison

;;;                 in *modules* is now case-insensitive. The result of

;;;                 this change is if the user cannot have distinct
;;;                 systems in "Foo.system" and "foo.system" named "Foo" and
;;;                 "foo", because they will clobber each other. There is
;;;                 still case-sensitivity on the filenames (i.e., if the
;;;                 system file is named "Foo.system" and you use "foo" in
;;;                 the :depends-on, it won't find it). We didn't take the
;;;                 further step of requiring system filenames to be lowercase
;;;                 because we actually find this kind of case-sensitivity
;;;                 to be useful, when maintaining two different versions

;;;                 of the same system.

;;;  7-MAR-95 mk    Added simplistic handling of logical pathnames. Also
;;;                 modified new-append-directories so that it'll try to

;;;                 split up pathname directories that are strings into a

;;;                 list of the directory components. Such directories aren't
;;;                 ANSI CL, but some non-conforming implementations do it.
;;;  7-MAR-95 mk    Added :proclamations to defsystem form, which can be used
;;;                 to set the compiler optimization level before compilation.

;;;                 For example,

;;;                  :proclamations '(optimize (safety 3) (speed 3) (space 0))
;;;  7-MAR-95 mk    Defsystem now tells the user when it reloads the system
;;;                 definition.
;;;  7-MAR-95 mk    Fixed problem pointed out by yc. If
;;;                 *source-pathname-default* is "" and there is no explicit
;;;                 :source-pathname specified for a file, the file could
;;;                 wind up with an empty file name. In other words, this
;;;                 global default shouldn't apply to :file components. Added
;;;                 explicit test for null strings, and when present replaced
;;;                 them with NIL (for binary as well as source, and also for
;;;                 :private-file components).
;;;  7-MAR-95 tar   Fixed defsystem to work on TI Explorers (TI CL).
;;;  7-MAR-95 jk    Added machine-type-translation for Decstation 5000/200
;;;                 under Allegro 3.1
;;;  7-MAR-95 as    Fixed bug in AKCL-1-615 in which defsystem added a
;;;                 subdirectory "RELATIVE" to all filenames.
;;;  7-MAR-95 mk    Added new test to test-new-append-directories to catch the
;;;                 error fixed by as. Essentially, this error occurs when the
;;;                 absolute-pathname has no directory (i.e., it has a single
;;;                 pathname component as in "foo" and not "foo/bar"). If
;;;                 RELATIVE ever shows up in the Result, we now know to
;;;                 add an extra conditionalization to prevent abs-keyword
;;;                 from being set to :relative.

;;;  7-MAR-95 ss    Miscellaneous fixes for MCL 2.0 final.

;;;                 *compile-file-verbose* not in MCL, *version variables
;;;                 need to occur before AFS-SOURCE-DIRECTORY definition,
;;;                 and certain code needed to be in the CCL: package.
;;;  8-MAR-95 mk    Y-OR-N-P-WAIT uses a busy-waiting. On Lisp systems where
;;;                 the time functions cons, such as CMU CL, this can cause a
;;;                 lot of ugly garbage collection messages. Modified the
;;;                 waiting to include calls to SLEEP, which should reduce
;;;                 some of the consing.
;;;  8-MAR-95 mk    Replaced fdmm's SET-LANGUAGE enhancement with a more
;;;                 general extension, along the lines suggested by akd.
;;;                 Defsystem now allows components to specify a :language
;;;                 slot, such as :language :lisp, :language :scheme. This
;;;                 slot is inherited (with the default being :lisp), and is
;;;                 used to obtain compilation and loading functions for
;;;                 components, as well as source and binary extensions. The
;;;                 compilation and loading functions can be overridden by
;;;                 specifying a :compiler or :loader in the system
;;;                 definition. Also added :documentation slot to the system

;;;                 definition.
;;;                    Where this comes in real handy is if one has a

;;;                 compiler-compiler implemented in Lisp, and wants the
;;;                 system to use the compiler-compiler to create a parser
;;;                 from a grammar and then compile parser. To do this one
;;;                 would create a module with components that looked
;;;                 something like this:
;;;		  ((:module cc :components ("compiler-compiler"))
;;;		   (:module gr :compiler 'cc :loader #'ignore
;;;			    :source-extension "gra"
;;;			    :binary-extension "lisp"
;;;			    :depends-on (cc)
;;;			    :components ("sample-grammar"))
;;;		   (:module parser :depends-on (gr)
;;;			    :components ("sample-grammar")))
;;;                 Defsystem would then compile and load the compiler, use
;;;                 it (the function cc) to compile the grammar into a parser,
;;;                 and then compile the parser. The only tricky part is
;;;                 cc is defined by the system, and one can't include #'cc
;;;                 in the system definition. However, one could include
;;;                 a call to mk:define-language in the compiler-compiler file,
;;;                 and define :cc as a language. This is the prefered method.
;;;  8-MAR-95 mk    New definition of topological-sort suggested by rs2. This
;;;                 version avoids the call to SORT, but in practice isn't
;;;                 much faster. However, it avoids the need to maintain a
;;;                 TIME slot in the topsort-node structure.
;;;  8-MAR-95 mk    rs2 also pointed out that the calls to MAKE-PATHNAME and
;;;                 NAMESTRING in COMPONENT-FULL-PATHNAME are a major reason
;;;                 why defsystem is slow. Accordingly, I've changed
;;;                 COMPONENT-FULL-PATHNAME to include a call to NAMESTRING
;;;                 (and removed all other calls to NAMESTRING), and also made
;;;                 a few changes to minimize the number of calls to
;;;                 COMPONENT-FULL-PATHNAME, such as memoizing it. See To Do
;;;                 below for other related comments.
;;;  8-MAR-95 mk    Added special hack requested by Steve Strassman, which
;;;                 allows one to specify absolute pathnames in the shorthand
;;;                 for a list of components, and have defsystem recognize

;;;                 which are absolute and which are relative.

;;;                 I actually think this would be a good idea, but I haven't
;;;                 tested it, so it is disabled by default. Search for
;;;                 *enable-straz-absolute-string-hack* to enable it.
;;;  8-MAR-95 kt    Fixed problem with EXPORT in AKCL 1.603, in which it wasn't
;;;                 properly exporting the value of the global export
;;;                 variables.
;;;  8-MAR-95 mk    Added UNMUNGE-LUCID to fix nasty problem with COMPILE-FILE
;;;                 in Lucid. Lucid apparently tries to merge the :output-file
;;;                 with the source file when the :output-file is a relative
;;;                 pathname. Wierd, and definitely non-standard.
;;;  9-MAR-95 mk    Changed ALLEGRO-MAKE-SYSTEM-FASL to also include the files
;;;                 in any systems the system depends on, as per a
;;;                 request of oc.
;;;  9-MAR-95 mk    Some version of CMU CL couldn't hack a call to
;;;                 MAKE-PATHNAME with :host NIL. I'm not sure which version
;;;                 it is, but the current version doesn't have this problem.
;;;                 If given :host nil, it defaults the host to

;;;                 COMMON-LISP::*UNIX-HOST*. So I haven't "fixed" this

;;;                 problem.
;;;  9-MAR-95 mk    Integrated top-level commands for Allegro designed by bha
;;;                 into the code, with slight modifications.
;;;  9-MAR-95 mk    Instead of having COMPUTE-SYSTEM-PATH check the current
;;;                 directory in a hard-coded fashion, include the current
;;;                 directory in the *central-registry*, as suggested by
;;;                 bha and others.
;;;  9-MAR-95 bha   Support for Logical Pathnames in Allegro.
;;;  9-MAR-95 mk    Added modified version of bha's DEFSYSPATH idea.
;;; 13-MAR-95 mk    Added a macro for the simple serial case, where a system
;;;                 (or module) is simple a list of files, each of which
;;;                 depends on the previous one. If the value of :components
;;;                 is a list beginning with :serial, it expands each
;;;                 component and makes it depend on the previous component.
;;;                 For example, (:serial "foo" "bar" "baz") would create a
;;;                 set of components where "baz" depended on "bar" and "bar"
;;;                 on "foo".
;;; 13-MAR-95 mk    *** Now version 3.0. This version is a interim bug-fix and
;;;                 update, since I do not have the time right now to complete
;;;                 the complete overhaul and redesign.
;;;                 Major changes in 3.0 include CMU CL 17, CLISP, ACLPC, TI,
;;;                 LispWorks and ACL(SGI) support, bug fixes for ACL 4.1/4.2.
;;; 14-MAR-95 fdmm  Finally added the bit of code to discriminate cleanly
;;;                 among different lisps without relying on (software-version)

;;;                 idiosyncracies.

;;;                 You can now customize COMPILER-TYPE-TRANSLATION so that
;;;                 AFS-BINARY-DIRECTORY can return a different value for
;;;                 different lisps on the same platform.
;;;                 If you use only one compiler, do not care about supporting

;;;                 code for multiple versions of it, and want less verbose

;;;                 directory names, just set *MULTIPLE-LISP-SUPPORT* to nil.
;;; 17-MAR-95 lmh   Added EVAL-WHEN for one of the MAKE-PACKAGE calls.
;;;                 CMU CL's RUN-PROGRAM is in the extensions package.
;;;                 ABSOLUTE-FILE-NAMESTRING-P was missing :test keyword
;;;                 Rearranged conditionalization in DIRECTORY-TO-LIST to
;;;                 suppress compiler warnings in CMU CL.
;;; 17-MAR-95 mk    Added conditionalizations to avoid certain CMU CL compiler
;;;                 warnings reported by lmh.

;;; 19990610  ma    Added shadowing of 'HARDCOPY-SYSTEM' for LW Personal Ed.

;;; 19991211  ma    NEW VERSION 4.0 started.
;;; 19991211  ma    Merged in changes requested by T. Russ of
;;;                 ISI. Please refer to the special "ISI" comments to
;;;                 understand these changes
;;; 20000228 ma     The symbols FIND-SYSTEM, LOAD-SYSTEM, DEFSYSTEM,
;;;                 COMPILE-SYSTEM and HARDCOPY-SYSTEM are no longer
;;;                 imported in the COMMON-LISP-USER package.
;;;                 Cfr. the definitions of *EXPORTS* and
;;;                 *SPECIAL-EXPORTS*.
;;; 2000-07-21 rlt  Add COMPILER-OPTIONS to defstruct to allow user to
;;;                 specify special compiler options for a particular
;;;                 component.
;;; 2002-01-08 kmr  Changed allegro symbols to lowercase to support
;;;                 case-sensitive images

;;;---------------------------------------------------------------------------
;;; ISI Comments
;;;
;;; 19991211 Marco Antoniotti
;;; These comments come from the "ISI Branch".  I believe I did
;;; include the :load-always extension correctly.  The other commets
;;; seem superseded by other changes made to the system in the
;;; following years.  Some others are now useless with newer systems
;;; (e.g. filename truncation for new Windows based CL
;;; implementations.)

;;;  1-OCT-92 tar   Fixed problem with TI Lisp machines and append-directory.
;;;  1-OCT-92 tar   Made major modifications to compile-file-operation and
;;;                 load-file-operation to reduce the number of probe-file
;;;                 and write-date inquiries.  This makes the system run much
;;;                 faster through slow network connections.
;;; 13-OCT-92 tar   Added :load-always slot to components. If this slot is
;;;                 specified as non-NIL, always loads the component.
;;;                 This does not trigger dependent compilation.
;;;                 (This can be useful when macro definitions needed
;;;                 during compilation are changed by later files.  In
;;;                 this case, not reloading up-to-date files can
;;;                 cause different results.)
;;; 28-OCT-93 tar   Allegro 4.2 causes an error on (pathname-device nil)
;;; 14-SEP-94 tar   Disable importing of symbols into (CL-)USER package
;;;                 to minimize conflicts with other defsystem utilities.
;;; 10-NOV-94 tar   Added filename truncation code to support Franz Allegro
;;;                 PC with it's 8 character filename limitation.
;;; 15-MAY-98 tar   Changed host attribute for pathnames to support LispWorks
;;;                 (Windows) pathnames which reference other Drives.  Also
;;;                 updated file name convention.
;;;  9-NOV-98 tar   Updated new-append-directories for Lucid 5.0
;;;


;;; ********************************
;;; Ports **************************
;;; ********************************
;;;
;;;    DEFSYSTEM has been tested (successfully) in the following lisps:
;;;       CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
;;;       CMU Common Lisp (14-Dec-90 beta, Python Compiler 0.0 PMAX/Mach)
;;;       CMU Common Lisp 17f (Python 1.0)
;;;       Franz Allegro Common Lisp 3.1.12 (ExCL 3/30/90)
;;;       Franz Allegro Common Lisp 4.0/4.1/4.2
;;;       Franz Allegro Common Lisp for Windows (2.0)
;;;       Lucid Common Lisp (Version 2.1 6-DEC-87)

;;;       Lucid Common Lisp (3.0 [SPARC,SUN3])

;;;       Lucid Common Lisp (4.0 [SPARC,SUN3])
;;;       VAXLisp (v2.2) [VAX/VMS]
;;;       VAXLisp (v3.1)
;;;       Harlequin LispWorks
;;;       CLISP (CLISP3 [SPARC])
;;;       Symbolics XL12000 (Genera 8.3)

;;;       Scieneer Common Lisp (SCL) 1.1
;;;       Macintosh Common Lisp
;;;       ECL

;;;
;;;    DEFSYSTEM needs to be tested in the following lisps:

;;;       OpenMCL

;;;       Symbolics Common Lisp (8.0)
;;;       KCL (June 3, 1987 or later)
;;;       AKCL (1.86, June 30, 1987 or later)
;;;       TI (Release 4.1 or later)
;;;       Ibuki Common Lisp (01/01, October 15, 1987)
;;;       Golden Common Lisp (3.1 IBM-PC)
;;;       HP Common Lisp (same as Lucid?)
;;;       Procyon Common Lisp

;;; ********************************
;;; To Do **************************

;;; ********************************

;;;
;;; COMPONENT-FULL-PATHNAME is a major source of slowness in the system
;;; because of all the calls to the expensive operations MAKE-PATHNAME
;;; and NAMESTRING. To improve performance, DEFSYSTEM should be reworked
;;; to avoid any need to call MAKE-PATHNAME and NAMESTRING, as the logical
;;; pathnames package does. Unfortunately, I don't have the time to do this

;;; right now. Instead, I installed a temporary improvement by memoizing

;;; COMPONENT-FULL-PATHNAME to cache previous calls to the function on
;;; a component by component and type by type basis. The cache is
;;; cleared before each call to OOS, in case filename extensions change.
;;; But DEFSYSTEM should really be reworked to avoid this problem and
;;; ensure greater portability and to also handle logical pathnames.
;;;
;;; Also, PROBE-FILE and FILE-WRITE-DATE are other sources of slowness.
;;; Perhaps by also memoizing FILE-WRITE-DATE and reimplementing PROBE-FILE
;;; in terms of FILE-WRITE-DATE, can achieve a further speed-up. This was
;;; suggested by Steven Feist (feist@ils.nwu.edu).
;;;
;;; True CLtL2 logical pathnames support -- can't do it, because CLtL2
;;; doesn't have all the necessary primitives, and even in Allegro CL 4.2

;;;   (namestring #l"foo:bar;baz.lisp")

;;; does not work properly.
;;;
;;; Create separate stand-alone documentation for defsystem, and also
;;; a test suite.
;;;
;;; Change SYSTEM to be a class instead of a struct, and make it a little
;;; more generic, so that it permits alternate system definitions.
;;; Replace OPERATE-ON-SYSTEM with MAP-SYSTEM (args: function, system-name,
;;; &rest options)
;;;
;;; Add a patch directory mechanism. Perhaps have several directories
;;; with code in them, and the first one with the specified file wins?
;;; LOAD-PATCHES function.
;;;
;;; Need way to load old binaries even if source is newer.
;;;
;;; Allow defpackage forms/package definitions in the defsystem? If
;;; a package not defined, look for and load a file named package.pkg?
;;;
;;; need to port for GNU CL (ala kcl)?
;;;
;;; Someone asked whether one can have :file components at top-level. I believe
;;; this is the case, but should double-check that it is possible (and if
;;; not, make it so).
;;;
;;; A common error/misconception seems to involve assuming that :system
;;; components should include the name of the system file, and that

;;; defsystem will automatically load the file containing the system
;;; definition and propagate operations to it. Perhaps this would be a

;;; nice feature to add.
;;;
;;; If a module is :load-only t, then it should not execute its :finally-do
;;; and :initially-do clauses during compilation operations, unless the
;;; module's files happen to be loaded during the operation.
;;;
;;; System Class. Customizable delimiters.
;;;
;;; Load a system (while not loading anything already loaded)
;;; and inform the user of out of date fasls with the choice
;;; to load the old fasl or recompile and then load the new
;;; fasl?

;;;

;;; modify compile-file-operation to handle a query keyword....
;;;
;;; Perhaps systems should keep around the file-write-date of the system
;;; definition file, to prevent excessive reloading of the system definition?
;;;
;;; load-file-operation needs to be completely reworked to simplify the
;;; logic of when files get loaded or not.
;;;
;;; Need to revamp output: Nesting and indenting verbose output doesn't
;;; seem cool, especially when output overflows the 80-column margins.
;;;
;;; Document various ways of writing a system. simple (short) form
;;; (where :components is just a list of filenames) in addition to verbose.
;;; Put documentation strings in code.
;;;
;;; :load-time for modules and systems -- maybe record the time the system
;;; was loaded/compiled here and print it in describe-system?
;;;

;;; Make it easy to define new functions that operate on a system. For
;;; example, a function that prints out a list of files that have changed,

;;; hardcopy-system, edit-system, etc.
;;;

;;; If a user wants to have identical systems for different lisps, do we
;;; force the user to use logical pathnames? Or maybe we should write a
;;; generic-pathnames package that parses any pathname format into a

;;; uniform underlying format (i.e., pull the relevant code out of
;;; logical-pathnames.lisp and clean it up a bit).
;;;
;;;    Verify that Mac pathnames now work with append-directories.
;;;
;;; A common human error is to violate the modularization by making a file
;;; in one module depend on a file in another module, instead of making
;;; one module depend on the other. This is caught because the dependency
;;; isn't found. However, is there any way to provide a more informative
;;; error message? Probably not, especially if the system has multiple
;;; files of the same name.

;;;

;;; For a module none of whose files needed to be compiled, have it print out
;;; "no files need recompilation".

;;;

;;; Write a system date/time to a file? (version information) I.e., if the
;;; filesystem supports file version numbers, write an auxiliary file to
;;; the system definition file that specifies versions of the system and

;;; the version numbers of the associated files.
;;;

;;; Add idea of a patch directory.

;;;

;;; In verbose printout, have it log a date/time at start and end of

;;; compilation:
;;;     Compiling system "test" on 31-Jan-91 21:46:47

;;;     by Defsystem version v2.0 01-FEB-91.

;;;

;;; Define other :force options:
;;;    :query    allows user to specify that a file not normally compiled
;;;              should be. OR
;;;    :confirm  allows user to specify that a file normally compiled
;;;              shouldn't be. AND

;;;

;;; We currently assume that compilation-load dependencies and if-changed
;;; dependencies are identical. However, in some cases this might not be
;;; true. For example, if we change a macro we have to recompile functions
;;; that depend on it (except in lisps that automatically do this, such
;;; as the new CMU Common Lisp), but not if we change a function. Splitting
;;; these apart (with appropriate defaulting) would be nice, but not worth
;;; doing immediately since it may save only a couple of file recompilations,

;;; while making defsystem much more complex than it already is.
;;;

;;; Current dependencies are limited to siblings. Maybe we should allow
;;; nephews and uncles? So long as it is still a DAG, we can sort it.
;;; Answer: No. The current setup enforces a structure on the modularity.
;;; Otherwise, why should we have modules if we're going to ignore it?

;;;

;;; Currently a file is recompiled more or less if the source is newer
;;; than the binary or if the file depends on a file that has changed
;;; (i.e., was recompiled in this session of a system operation).
;;; Neil Goldman <goldman@isi.edu> has pointed out that whether a file
;;; needs recompilation is really independent of the current session of
;;; a system operation, and depends only on the file-write-dates of the
;;; source and binary files for a system. Thus a file should require
;;; recompilation in the following circumstances:
;;;   1. If a file's source is newer than its binary, or
;;;   2. If a file's source is not newer than its binary, but the file

;;;      depends directly or indirectly on a module (or file) that is newer.

;;;      For a regular file use the file-write-date (FWD) of the source or
;;;      binary, whichever is more recent. For a load-only file, use the only
;;;      available FWD. For a module, use the most recent (max) FWD of any of
;;;      its components.
;;; The impact of this is that instead of using a boolean CHANGED variable
;;; throughout the code, we need to allow CHANGED to be NIL/T/<FWD> or
;;; maybe just the FWD timestamp, and to use the value of CHANGED in
;;; needs-compilation decisions. (Use of NIL/T as values is an optimization.
;;; The FWD timestamp which indicates the most recent time of any changes

;;; should be sufficient.) This will affect not just the
;;; compile-file-operation, but also the load-file-operation because of

;;; compilation during load. Also, since FWDs will be used more prevalently,
;;; we probably should couple this change with the inclusion of load-times
;;; in the component defstruct. This is a tricky and involved change, and
;;; requires more thought, since there are subtle cases where it might not
;;; be correct. For now, the change will have to wait until the DEFSYSTEM
;;; redesign.

;;; ********************************************************************
;;; How to Use this System *********************************************
;;; ********************************************************************

;;; To use this system,

;;; 1. If you want to have a central registry of system definitions,

;;;    modify the value of the variable *central-registry* below.
;;; 2. Load this file (defsystem.lisp) in either source or compiled form,
;;; 3. Load the file containing the "defsystem" definition of your system,
;;; 4. Use the function "operate-on-system" to do things to your system.

;;; For more information, see the documentation and examples in

;;; lisp-utilities.ps.

;;; ********************************
;;; Usage Comments *****************
;;; ********************************

;;; If you use symbols in the system definition file, they get interned in

;;; the COMMON-LISP-USER package, which can lead to name conflicts when
;;; the system itself seeks to export the same symbol to the COMMON-LISP-USER
;;; package. The workaround is to use strings instead of symbols for the

;;; names of components in the system definition file. In the major overhaul,

;;; perhaps the user should be precluded from using symbols for such
;;; identifiers.
;;;
;;; If you include a tilde in the :source-pathname in Allegro, as in "~/lisp",

;;; file name expansion is much slower than if you use the full pathname,

;;; as in "/user/USERID/lisp".
;;;


;;; ****************************************************************
;;; Lisp Code ******************************************************
;;; ****************************************************************

;;; ********************************
;;; Massage CLtL2 onto *features* **
;;; ********************************
;;; Let's be smart about CLtL2 compatible Lisps:
(eval-when (compile load eval)

  #+(or (and allegro-version>= (version>= 4 0)) :mcl :sbcl)

  (pushnew :cltl2 *features*))

;;; ********************************
;;; Provide/Require/*modules* ******
;;; ********************************

;;; Since CLtL2 has dropped require and provide from the language, some
;;; lisps may not have the functions PROVIDE and REQUIRE and the
;;; global *MODULES*. So if lisp::provide and user::provide are not
;;; defined, we define our own.

;;; Hmmm. CMU CL old compiler gives bogus warnings here about functions
;;; and variables not being declared or bound, apparently because it
;;; sees that (or (fboundp 'lisp::require) (fboundp 'user::require)) returns
;;; T, so it doesn't really bother when compiling the body of the unless.
;;; The new compiler does this properly, so I'm not going to bother
;;; working around this.

;;; Some Lisp implementations return bogus warnings about assuming
;;; *MODULE-FILES* and *LIBRARY* to be special, and CANONICALIZE-MODULE-NAME
;;; and MODULE-FILES being undefined. Don't worry about them.

;;; Now that ANSI CL includes PROVIDE and REQUIRE again, is this code

;;; necessary?

#-(or :CMU
      :vms
      :mcl
      :lispworks
      :clisp
      :gcl
      :sbcl
      :cormanlisp
      :scl

      (and allegro-version>= (version>= 4 1)))

(eval-when #-(or :lucid)
           (:compile-toplevel :load-toplevel :execute)
	   #+(or :lucid)
           (compile load eval)

  (unless (or (fboundp 'lisp::require)
	      (fboundp 'user::require)

	      #+(and :excl (and allegro-version>= (version>= 4 0)))
	      (fboundp 'cltl1::require)

	      #+:lispworks
	      (fboundp 'system::require))

    #-:lispworks

    (in-package "LISP")

    #+:lispworks

    (in-package "SYSTEM")

    (export '(*modules* provide require))

    ;; Documentation strings taken almost literally from CLtL1.

    (defvar *modules* ()

      "List of names of the modules that have been loaded into Lisp so far.
     It is used by PROVIDE and REQUIRE.")

    ;; We provide two different ways to define modules. The default way
    ;; is to put either a source or binary file with the same name
    ;; as the module in the library directory. The other way is to define
    ;; the list of files in the module with defmodule.

    ;; The directory listed in *library* is implementation dependent,
    ;; and is intended to be used by Lisp manufacturers as a place to

    ;; store their implementation dependent packages.

    ;; Lisp users should use systems and *central-registry* to store
    ;; their packages -- it is intended that *central-registry* is
    ;; set by the user, while *library* is set by the lisp.

    (defvar *library* nil		; "/usr/local/lisp/Modules/"
      "Directory within the file system containing files, where the name
     of a file is the same as the name of the module it contains.")

    (defvar *module-files* (make-hash-table :test #'equal)
      "Hash table mapping from module names to list of files for the
     module. REQUIRE loads these files in order.")

    (defun canonicalize-module-name (name)
      ;; if symbol, string-downcase the printrep to make nicer filenames.
      (if (stringp name) name (string-downcase (string name))))

    (defmacro defmodule (name &rest files)
      "Defines a module NAME to load the specified FILES in order."
      `(setf (gethash (canonicalize-module-name ,name) *module-files*)
	     ',files))
    (defun module-files (name)
      (gethash name *module-files*))

    (defun provide (name)

      "Adds a new module name to the list of modules maintained in the

     variable *modules*, thereby indicating that the module has been

     loaded. Name may be a string or symbol -- strings are case-senstive,
     while symbols are treated like lowercase strings. Returns T if
     NAME was not already present, NIL otherwise."
      (let ((module (canonicalize-module-name name)))
	(unless (find module *modules* :test #'string=)

	  ;; Module not present. Add it and return T to signify that it

	  ;; was added.
	  (push module *modules*)
	  t)))

    (defun require (name &optional pathname)

      "Tests whether a module is already present. If the module is not
     present, loads the appropriate file or set of files. The pathname
     argument, if present, is a single pathname or list of pathnames
     whose files are to be loaded in order, left to right. If the
     pathname is nil, the system first checks if a module was defined
     using defmodule and uses the pathnames so defined. If that fails,
     it looks in the library directory for a file with name the same
     as that of the module. Returns T if it loads the module."
      (let ((module (canonicalize-module-name name)))
	(unless (find module *modules* :test #'string=)
	  ;; Module is not already present.
	  (when (and pathname (not (listp pathname)))
	    ;; If there's a pathname or pathnames, ensure that it's a list.
	    (setf pathname (list pathname)))

	  (unless pathname

	    ;; If there's no pathname, try for a defmodule definition.
	    (setf pathname (module-files module)))
	  (unless pathname
	    ;; If there's still no pathname, try the library directory.
	    (when *library*
	      (setf pathname (concatenate 'string *library* module))
	      ;; Test if the file exists.

	      ;; We assume that the lisp will default the file type

	      ;; appropriately. If it doesn't, use #+".fasl" or some
	      ;; such in the concatenate form above.
	      (if (probe-file pathname)
		  ;; If it exists, ensure we've got a list
		  (setf pathname (list pathname))
		  ;; If the library file doesn't exist, we don't want
		  ;; a load error.
		  (setf pathname nil))))
	  ;; Now that we've got the list of pathnames, let's load them.

	  (dolist (pname pathname t)
	    (load pname :verbose nil))))))
  ) ; eval-when

;;; ********************************
;;; Set up Package *****************
;;; ********************************


;;; Unfortunately, lots of lisps have their own defsystems, some more
;;; primitive than others, all uncompatible, and all in the DEFSYSTEM
;;; package. To avoid name conflicts, we've decided to name this the
;;; MAKE package. A nice side-effect is that the short nickname
;;; MK is my initials.

#+(or clisp cormanlisp ecl (and gcl defpackage) sbcl)
(defpackage "MAKE" (:use "COMMON-LISP") (:nicknames "MK"))

#-(or :sbcl :cltl2 :lispworks :ecl :scl)

(in-package "MAKE" :nicknames '("MK"))

;;; For CLtL2 compatible lisps...