Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/load.clisp
There is 1 other file named load.clisp in the archive. Click here to see a list.
;;; -*- 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*)))))