Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

;;; -*- 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)))