/[slime]/slime/swank-loader.lisp
ViewVC logotype

Diff of /slime/swank-loader.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.16 by wjenkner, Thu Feb 5 05:57:04 2004 UTC revision 1.17 by heller, Wed Feb 18 07:31:59 2004 UTC
# Line 35  Line 35 
35            #+clisp '("xref" "metering" "swank-clisp" "swank-gray")            #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
36            ))            ))
37    
38    (defparameter *lisp-name*
39      #+cmu "cmu"
40      #+sbcl "sbcl"
41      #+openmcl "openmcl"
42      #+lispworks "lispworks"
43      #+allegro "allegro"
44      #+clisp "clisp")
45    
46  (defparameter *swank-pathname* (make-swank-pathname "swank"))  (defparameter *swank-pathname* (make-swank-pathname "swank"))
47    
48  (defun file-newer-p (new-file old-file)  (defun file-newer-p (new-file old-file)
49    "Returns true if NEW-FILE is newer than OLD-FILE."    "Returns true if NEW-FILE is newer than OLD-FILE."
50    (> (file-write-date new-file) (file-write-date old-file)))    (> (file-write-date new-file) (file-write-date old-file)))
51    
52    (defun binary-pathname (source-pathname)
53      (merge-pathnames
54       (make-pathname :directory `(:relative "fasl" ,*lisp-name*))
55       (merge-pathnames (compile-file-pathname source-pathname))))
56    
57  (defun compile-files-if-needed-serially (files)  (defun compile-files-if-needed-serially (files)
58    "Compile each file in FILES if the source is newer than    "Compile each file in FILES if the source is newer than
59  its corresponding binary, or the file preceding it was  its corresponding binary, or the file preceding it was
# Line 48  recompiled." Line 61  recompiled."
61    (with-compilation-unit ()    (with-compilation-unit ()
62      (let ((needs-recompile nil))      (let ((needs-recompile nil))
63        (dolist (source-pathname files)        (dolist (source-pathname files)
64          (let ((binary-pathname (compile-file-pathname source-pathname)))          (let ((binary-pathname (binary-pathname source-pathname)))
65            (handler-case            (handler-case
66                (progn                (progn
67                  (when (or needs-recompile                  (when (or needs-recompile
68                            (not (probe-file binary-pathname))                            (not (probe-file binary-pathname))
69                            (file-newer-p source-pathname binary-pathname))                            (file-newer-p source-pathname binary-pathname))
70                    (format t "~&;; Compiling ~A...~%" source-pathname)                    (format t "~&;; Compiling ~A...~%" source-pathname)
71                    (compile-file source-pathname)                    (ensure-directories-exist binary-pathname)
72                      (compile-file source-pathname :output-file binary-pathname)
73                    (setq needs-recompile t))                    (setq needs-recompile t))
74                  (load binary-pathname))                  (load binary-pathname))
75              #+(or)              #+(or)

Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17

  ViewVC Help
Powered by ViewVC 1.1.5