[asdf-addons-cvs] r1 - in trunk: . asdf-addons

[mkocic at common-lisp.net]

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