(defpackage #:asdf-cache
    (:use #:cl)
  (:export #:*asdf-cache*
	   #:*exclusions*))

(in-package #:asdf-cache)

;;; clc like functionality
(defparameter *asdf-cache* nil)
(defparameter *exclusions* 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))))

(defun excluded (path)
  (let ((target (directory-namestring path)))
    (dolist (exc *exclusions*)
      ;;(format t "exc = ~A~&"  exc)
      ;;(format t "target = ~A~&"  target)
      (when (search exc target)
	(return t)))))

(defun calculate-path (path)
  (if (excluded path)
      path
      (merge-pathnames
       (make-pathname :directory
		      (append
		       (pathname-directory *asdf-cache*)
		       (list ".fasls" (unique-directory-name))
		       (rest (pathname-directory path))))
       path)))

(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 #'calculate-path 
            paths)))