(in-package #:portaCL)

(defclass port-mixin ()
  ((format-name :initform ""
                :initarg :format-name
                :accessor format-name)
   (alternate-file :initform nil
                   :initarg :alternate-file
                   :accessor alternate-file)
   (not-found-condition :initform 'not-implemented
                        :initarg :not-found-condition
                        :accessor not-found-condition))
  (:documentation "Like cl-source-file, but offers the ability to splice the
  implementation type into the name."))

(defclass port-file (port-mixin asdf:cl-source-file) ())
(defclass port-module (port-mixin asdf:module) ())

;; ASDF does instantiation kinda funky.
(defmethod reinitialize-instance :after ((port-component port-mixin) &key name alternate-file &allow-other-keys)
  (when name
    (setf (format-name port-component)
          name))
  (when alternate-file
    (setf (alternate-file port-component)
          (merge-pathnames alternate-file (asdf::component-parent-pathname port-component)))))

;; SPOOKY!  component-pathname defaults to using the component-name.  We take
;; advantage of that to provide an implementation-dependent pathname while
;; leaving the component name as the original format string.
(defmethod asdf:component-name ((port port-mixin))
  (if *implementation*
      (format nil (format-name port) *implementation*)
      (format-name port)))

;; Beware the nearly duplicate code in the following two methods.  It's not
;; really worth factoring out, so be sure to make changes in both.
(defmethod asdf:component-pathname ((port port-module))
  (or (first (some #'directory
                   (loop :for *implementation* :in (lisp-implementation-names)
                         :collect (call-next-method))))
      (and (alternate-file port)
           (directory (alternate-file port)))
      (error (not-found-condition port))))

(defmethod asdf:component-pathname ((port port-file))
  (or (some #'probe-file
            (loop :for *implementation* :in (lisp-implementation-names)
                  :collect (call-next-method)))
      (and (alternate-file port)
           (probe-file (alternate-file port)))
      (error (not-found-condition port))))

;; If the component is unnecessary, then no worries mate.  And yes, both of
;; these methods are necessary.
(defmethod asdf:operation-done-p :around ((o asdf:operation) (component port-mixin))
  (handler-case (call-next-method)
    (not-necessary () t)))
(defmethod asdf:perform :around ((operation asdf:operation) (component port-mixin))
  (handler-case (call-next-method)
    (not-necessary () t)))

;; Make :port-file work in system definitions
(eval-when (:compile-toplevel :load-toplevel :execute)
  (import 'port-file :asdf)
  (import 'port-module :asdf))

;; testing examples
#+nil (pushnew #p"l:/clbuild/source/portaCL/examples/" asdf::*subdir-search-registry*)