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). 
;;; **********************************************************************
;;;
;;; Loader for Spice Lisp.
;;; Written by Skef Wholey.
;;;

(in-package 'lisp)

(export '(load *load-verbose* *file-being-loaded*))

;;; Package-Name isn't defined when this is first loaded
(eval-when (eval load)
  (if (not (fboundp 'package-name))
      (defun package-name (package) (declare (ignore package))
	"#<Some package>")))

(defvar *load-verbose* ()
  "The default for the :Verbose argument to Load.")

(defvar *load-print-stuff* ()
  "True if we're gonna mumble about what we're loading.")

(defvar *file-being-loaded* nil
  "While the system is loading a file, this is the truename of the file.
  The rest of the time it is nil.")

;;; Sloload:

;;; Something not EQ to anything read from a file:

(defconstant load-eof-value '(()))

;;; Sloload loads a text file into the given Load-Package.

(defun sloload (stream)
  (do ((sexpr (read stream nil load-eof-value)
	      (read stream nil load-eof-value)))
      ((eq sexpr load-eof-value))
	(if *load-print-stuff*
	    (print (eval sexpr))
	    (eval sexpr))))))

;;; Load:

(defun load (filename &key
		      (verbose *load-verbose*)
		      ((:print *load-print-stuff*) ())
		      (package *package*)
		      (if-does-not-exist :error))
  "Loads the file named by Filename into the Lisp environment.  See manual
   for details."
  (let ((stream)
	(*package* package))
    (if (streamp filename)
	(setq stream filename)
	(let ((pathname (merge-pathnames filename)))
	  (if (null (pathname-type pathname))
	      (cond ((null (probe-file
			    (modify-pathname-type pathname "lap")))
		     ;; foo.LAP doesn't exist, use foo.CLISP
		     (setq pathname (modify-pathname-type pathname "clisp")))
		    ((null (probe-file
			    (modify-pathname-type pathname "clisp")))
		     ;; foo.CLISP doesn't exist (and foo.LAP exists)...
		     ;; use foo.LAP
		     (setq pathname (modify-pathname-type pathname "lap")))
		    (t ;CLISP and LAP both exist, use youngest one.
		     (if (<= (file-write-date
			      (modify-pathname-type pathname "clisp"))
			     (file-write-date
			      (modify-pathname-type pathname "lap")))
			 (setq pathname (modify-pathname-type pathname "lap"))
			 (setq pathname
			       (modify-pathname-type pathname "clisp"))))))
	  (setq stream
		(open pathname
		      :direction :input
		      :element-type 'string-char
		      :if-does-not-exist if-does-not-exist))))
    (if (not stream)
	(return-from load nil))
    (if verbose
	(if (streamp filename)
	    (format t "~&;Loading ~A into package ~A.~%"
		    stream (package-name (pathname-package stream)))
	    (format t "~&;Loading ~A into package ~A.~%"
		    (namestring (truename stream))
		    (package-name (pathname-package stream)))))
    (unwind-protect
     (let ((*file-being-loaded* (truename stream)))
       (sloload stream))
     (close stream)))
  t)

(defun pathname-package (pathname)
  "Returns the package of the file referred"
  (with-open-file (stream pathname :direction :input)
    (let ((*package* *package*))
      (flet ((is-package-decl (expr)
	         (and (string= (symbol-name (first expr)) "IN-PACKAGE")
		      (eval expr))))
	 (or (is-package-decl (read stream nil nil))
	     (is-package-decl (read stream nil nil))
	     (is-package-decl (read stream nil nil))
	     *package*)))))