/[gcl]/gcl/ansi-tests/compile-and-load.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/compile-and-load.lsp

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

revision 1.4 by pfdietz, Wed Apr 9 02:26:51 2003 UTC revision 1.5 by pfdietz, Tue Jun 17 12:43:11 2003 UTC
# Line 12  Line 12 
12      (defun compile-file-pathname (pathname)      (defun compile-file-pathname (pathname)
13        (make-pathname :defaults pathname :type "o"))))        (make-pathname :defaults pathname :type "o"))))
14    
15  (defun compile-and-load (pathspec)  ;;; On-demand compile and load
16    
17    (defvar *compiled-and-loaded-files* nil
18      "List containing pathname, creation times for files that have already
19       been loaded.")
20    
21    (defun compile-and-load (pathspec &key force)
22    "Find the file indicated by PATHSPEC, compiling it first if    "Find the file indicated by PATHSPEC, compiling it first if
23     the associated compiled file is out of date."     the associated compiled file is out of date."
24    (let* ((pathname (pathname pathspec))    (let* ((pathname (pathname pathspec))
25             (former-data (assoc pathname *compiled-and-loaded-files*
26                                 :test #'equalp))
27           (compile-pathname (compile-file-pathname pathname))           (compile-pathname (compile-file-pathname pathname))
28           (source-write-time (file-write-date pathname))           (source-write-time (file-write-date pathname))
29           (target-write-time (and (probe-file compile-pathname)           (target-write-time (and (probe-file compile-pathname)
30                                   (file-write-date compile-pathname))))                                   (file-write-date compile-pathname))))
31      (when (or (not target-write-time)      (unless (and (not force)
32                (<= target-write-time source-write-time))                   former-data
33        (compile-file pathname))                   (<= (cadr former-data) source-write-time))
34      (load compile-pathname)))        (when (or (not target-write-time)
35                    (<= target-write-time source-write-time))
36  ;;; On-demand compile and load          (compile-file pathname))
37          (if former-data
38  (defvar *compiled-and-loaded-files* nil            (setf (cadr former-data) source-write-time)
39    "List containing pathname, creation times for files that have already          (push (list pathname source-write-time) *compiled-and-loaded-files*))
40     been loaded.")        (load compile-pathname))))
   
   
   

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26