Author: mkocic Date: Fri Mar 10 04:28:48 2006 New Revision: 1 Added: trunk/ trunk/asdf-addons/ trunk/asdf-addons/asdf-cache.lisp Log: initial commit Added: trunk/asdf-addons/asdf-cache.lisp ============================================================================== --- (empty file) +++ trunk/asdf-addons/asdf-cache.lisp Fri Mar 10 04:28:48 2006 @@ -0,0 +1,63 @@ +(defpackage #:asdf-cache + (:use #:cl) + (:export #:*asdf-cache*)) + +(in-package #:asdf-cache) + +;;; clc like functionality +(defparameter *asdf-cache* nil) + +(defparameter *implementation-features* + '(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :cormanlisp + :armedbear :gcl :ecl)) + +(defparameter *os-features* + '(:macosx :macos :linux :windows :mswindows :win32 :solaris :darwin :sunos + :unix)) + +(defparameter *architecture-features* + '(:powerpc :ppc :x86 :x86-64 :i686 :pc386 :iapx386 :sparc)) + +(defun lisp-version-string () + #+cmu (substitute #\- #\/ (lisp-implementation-version)) + #+gcl (let ((s (lisp-implementation-version))) (subseq s 4)) + #+openmcl (format nil "~d.~d" ccl::*openmcl-major-version* + ccl::*openmcl-minor-version*) + #+allegro excl::*common-lisp-version-number* + #+clisp (let ((s (lisp-implementation-version))) + (subseq s 0 (position #\space s))) + #+(or sbcl ecl lispworks armedbear cormanlisp) + (lisp-implementation-version) + #-(or cmu gcl openmcl allegro clisp sbcl ecl lispworks armedbear cormanlisp) + "unknown") + +(defun unique-directory-name () + "Return a name that can be used as a directory name that is +unique to a Lisp implementation, Lisp implementation version, +operating system, and hardware architecture." + (flet ((first-of (features) + (or (loop for f in features + when (find f *features*) return it) + "unknown"))) + (format nil "~(~@{~A~^-~}~)" + (first-of *implementation-features*) + (first-of *os-features*) + (first-of *architecture-features*) + (lisp-version-string)))) + + + +(defmethod asdf:output-files :around ((op asdf:compile-op) (src asdf:source-file)) + (unless *asdf-cache* + (error "*asdf-cache* must be set to not nil value")) + (let ((paths (call-next-method))) + (mapcar (lambda (path) + (merge-pathnames + (make-pathname :directory + (append + (pathname-directory *asdf-cache*) + (list ".fasls" (unique-directory-name)) + (rest (pathname-directory path)))) + path)) + paths))) +