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)))
+
