load-compiled-op code

;; load-only-compiled-op is an ASDF operation that only loads
;; compiled code

(in-package :asdf)
(define-condition load-compiled-error (error)
  ((output-file :initform nil :initarg :output-file :reader output-file))
  (:report (lambda (c s)
	       (format s "Error when performing load-compiled-op with output file ~A"
		       (output-file c)))))

(define-condition load-compiled-error-not-exist (load-compiled-error)
  ()
  (:report (lambda (c s)
	       (format s "During load-compiled-op, compiled file ~A does not exist"
		       (output-file c)))))

(define-condition load-compiled-error-out-dated (load-compiled-error)
  ((source-file :initform nil :initarg :source-file :reader source-file))
  (:report (lambda (c s)
	     (format s "During load-compiled-op, compiled file ~A is older than source file ~A"
		     (output-file c) (source-file c)))))

(defclass load-compiled-op (operation)
  ()
  (:documentation "This operation loads each compiled file for a component. If  a binary component does not exist then the condition load-compiled-error-not-exist will be signaled. If both the source file and binary components exists, and if the file-write-date of the binary is earlier than the source, then the condition load-compiled-error-out-dated will be signaled."))

(defmethod operation-done-p ((o load-compiled-op) (c source-file))
  "This method should really compare the :last-loaded time of the source-file
 to the file-write-date of the output files. If :last-loaded is not NIL and is less
than the minimum file-write-date of output-files, then return T."
  nil)
  
(defmethod output-files ((operation load-compiled-op)
			 (c cl-source-file))
  (list (compile-file-pathname (component-pathname c))))

(defmethod perform ((o load-compiled-op) (c source-file))
  (let* ((co (make-sub-operation o 'compile-op))
	 (output-files (output-files co c))
	 (source-date (when (probe-file (component-pathname c))
			(file-write-date (component-pathname c)))))
    (dolist (of output-files)
      (unless (probe-file of)
	(error 'load-compiled-error-not-exist
	       :output-file of))
      (when (and source-date
		 (> source-date (file-write-date of)))
	(error 'load-compiled-error-out-dated
	       :output-file of
	       :source-file (component-pathname c)))
      (load of))
    (setf (component-property c ':last-loaded)
	  (file-write-date (car output-files)))))

(export 'load-compiled-op)


-------------------------------------------------------
This SF.NET email is sponsored by: AMD - Your access to the experts
on Hammer Technology! Open Source & Linux Developers, register now
for the AMD Developer Symposium. Code: EX8664
http://www.developwithamd.com/developerlab