Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/provide.clisp
There are no other files named provide.clisp in the archive.
;;; -*- Lisp -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; This facility is required by Common Lisp, and is thus provided by
;;; Spice Lisp. Code written by Jim Muller, witty commentary by
;;; Rob MacLachlan. Rewritten for the Dec-20 version by Dave Steiner.
;;;
(in-package 'lisp)
(export '(*modules* provide require *require-verbose*
*module-file-translations* *clisp-modules-file*))
(defvar *modules* '()
"This is a list of (case-sensitive) names of modules that have been loaded
into the LISP system so far. Normally a module will update this list using
provide, and require will check it before loading its files.")
(defvar *module-file-translations* '()
"This is an a-list mapping modules to lists of file names. Normally
it is read from the file *clisp-modules-file* when CLisp sees the
first REQUIRE. The user can change this or add to this before
CLisp reads the first REQUIRE; when reading in the a-list from
*clisp-modules-file*, will only add NEW entries onto the a-list.")
(defvar *clisp-modules-file* "clisp-modules.clisp"
"This is the string name of a file whose first sexpression should
be an a-list mapping module names (case-sensitive strings) to lists
of files which should be loaded when requiring that module.")
(defvar *require-verbose* t
"If non-nil, require prints out which files are loaded.")
(defun provide (module-name)
"Tell the LISP system that the module whose (case-sensitive) name is
Module-name has already been loaded. Returns nil."
(pushnew module-name *modules* :test #'string=)
nil)
(defun require (module-name &optional pathname)
"This tests whether the module whose (case-sensitive) name is
Module-name has already been loaded. If not, it attempts to load
the module from the files on Pathname, or uses the following method
if no pathname is provided: The files loaded are those which appear
with the module in the a-list *Module-file-translations*, or in the
*Clisp-modules-file*, or simply the single file
<Module-name>.Clisp or .Lap (whichever is youngest), or looks for it on
CLISP:. Tell which files are loaded if *require-verbose* is non-NIL.
Returns whether the module was loaded."
(unless (member module-name *modules* :test #'string=)
;; Load up the module to file translations if they aren't there.
(when (and (not *modules*) (probe-file (pathname *clisp-modules-file*)))
(with-open-file (f *clisp-modules-file*)
(setq *module-file-translations*
(append *module-file-translations* (read f)))))
;; Make a list of pathnames
(unless (listp pathname) (setq pathname (list pathname)))
(do ((f pathname (cdr f)))
((null f))
(rplaca f (pathname (car f))))
;; If pathname arg is non-NIL, load those files.
(if pathname
(let* ((*load-verbose* *require-verbose*))
(dolist (p pathname)
(if (not (load p :if-does-not-exist nil))
(if (not (load (make-clisp-device-pathname p)
:if-does-not-exist nil))
(if *require-verbose*
(format t "Could not find file ~S.~%" p))))))
;; Get the list of files and load them in the right order. Tell
;; the user.
(let* ((files (or (cdr (assoc module-name *module-file-translations*
:test #'string=))
(list module-name)))
(*load-verbose* *require-verbose*))
(dolist (f files)
(setq f (pathname f))
(if (not (load f :if-does-not-exist nil))
(if (not (load (make-clisp-device-pathname f)
:if-does-not-exist nil))
(if *require-verbose*
(format t "Could not find file ~S.~%" f)))))))
t))
;;; MODIFY-PATHNAME-TYPE creates a pathname just like its argument, but
;;; substituting the specified type. Code borrowed from CLC.CLISP.
(defun modify-pathname-type (pathname type)
(make-pathname :host (pathname-host pathname)
:device (pathname-device pathname)
:directory (pathname-directory pathname)
:name (pathname-name pathname)
:type type
:version :newest))
(defun make-clisp-device-pathname (pathname)
"Make a pathname just like the argument, but on logical device CLISP:"
(let ((pathname (if (pathnamep pathname) pathname
(parse-namestring pathname))))
(make-pathname :host (pathname-host pathname)
:device "Clisp"
:directory nil
:name (pathname-name pathname)
:type (pathname-type pathname)
:version :newest)))