:for f :in files
              :for new-f = (make-pathname :name (pathname-name f)
                                :type (pathname-type f)
                                :defaults dest-path)
              :do (rename-file-overwriting-target f new-f)
              :collect new-f)
        files)))

;;;
;;; LOAD-FASL-OP
;;;
;;; This is like ASDF's LOAD-OP, but using monolithic fasl files.
;;;

(defmethod component-depends-on ((o load-fasl-op) (c system))
  (declare (ignorable o))
  `((load-fasl-op ,@(loop :for dep :in (component-sibling-dependencies c)
                     :collect (resolve-dependency-spec c dep)))
    (,(if (user-system-p c) 'fasl-op 'load-op) ,c)
    ,@(call-next-method)))

(defmethod input-files ((o load-fasl-op) (c system))
  (when (user-system-p c)
    (output-files (find-operation o 'fasl-op) c)))

(defmethod perform ((o load-fasl-op) c)
  (declare (ignorable o c))
  nil)

(defmethod perform ((o load-fasl-op) (c system))
  (aif (first (input-files o c)) (load it)))

(defmethod mark-operation-done :after ((o load-fasl-op) (c system))
  (mark-operation-done (find-operation o 'load-op) c)) ; need we recurse on gather-components?

;;;
;;; PRECOMPILED FILES
;;;
;;; This component can be used to distribute ASDF systems in precompiled form.
;;; Only useful when the dependencies have also been precompiled.
;;;

(defmethod trivial-system-p ((s system))
  (every #'(lambda (c) (typep c 'compiled-file)) (component-children s)))

(defmethod output-files (o (c compiled-file))
  (declare (ignorable o c))
  nil)
(defmethod input-files (o (c compiled-file))
  (declare (ignorable o))
  (component-pathname c))
(defmethod perform ((o load-op) (c compiled-file))
  (declare (ignorable o))
  (load (first (input-files o c))))
(defmethod perform ((o load-source-op) (c compiled-file))
  (perform (find-operation o 'load-op) c))
(defmethod perform ((o load-fasl-op) (c compiled-file))
  (perform (find-operation o 'load-op) c))
(defmethod perform (o (c compiled-file))
  (declare (ignorable o c))
  nil)

;;;
;;; Pre-built systems
;;;
(defmethod trivial-system-p ((s prebuilt-system))
  (declare (ignorable s))
  t)

(defmethod output-files ((o lib-op) (c prebuilt-system))
  (declare (ignorable o))
  (values (list (prebuilt-system-static-library c))
          t)) ; Advertise that we do not want this path renamed by asdf-output-translations

(defmethod perform ((o lib-op) (c prebuilt-system))
  (first (output-files o c)))

(defmethod component-depends-on ((o lib-op) (c prebuilt-system))
  (declare (ignorable o c))
  nil)

(defmethod bundle-sub-operations ((o lib-op) (c prebuilt-system))
  (declare (ignorable o c))
  nil)

(defmethod bundle-sub-operations ((o monolithic-lib-op) (c prebuilt-system))
  (declare (ignorable o))
  (error "Prebuilt system ~S shipped with ECL can not be used in a monolithic library operation." c))

(defmethod bundle-sub-operations ((o monolithic-bundle-op) (c prebuilt-system))
  (declare (ignorable o c))
  nil)

;;;
;;; PREBUILT SYSTEM CREATOR
;;;

(defun* binary-op-dependencies (o s)
  (multiple-value-bind (lib-op fasl-op)
      (if (operation-monolithic-p o)
          (values 'monolithic-lib-op 'monolithic-fasl-op)
          (values 'lib-op 'fasl-op))
    `((,(find-operation o lib-op) ,s)
      (,(find-operation o fasl-op) ,s))))

(defmethod component-depends-on ((o binary-op) (s system))
  `(,@(loop :for dep :in (binary-op-dependencies o s)
            :append (apply #'component-depends-on dep))
    ,@(call-next-method)))

(defmethod input-files ((o binary-op) (s system))
  (loop :for dep :in (binary-op-dependencies o s)
        :append (apply #'input-files dep)))

(defmethod output-files ((o binary-op) (s system))
  (list* (merge-pathnames* (make-pathname :name (component-name s)
                                          :type "asd")
                           (component-relative-pathname s))
         (loop :for dep :in (binary-op-dependencies o s)
               :append (apply #'output-files dep))))

(defmethod perform ((o binary-op) (s system))
  (let* ((dependencies (binary-op-dependencies o s))
         (library (first (apply #'output-files (first dependencies))))
         (fasl (first (apply #'output-files (second dependencies))))
         (filename (first (output-files o s)))
         (name (component-name s))
         (name-keyword (intern (string name) (find-package :keyword))))
    (dolist (dep dependencies)
      (apply #'perform dep))
    (with-open-file (s filename :direction :output :if-exists :supersede
                       :if-does-not-exist :create)
      (format s ";;; Prebuilt ASDF definition for system ~A" name)
      (format s ";;; Built for ~A ~A on a ~A/~A ~A"
              (lisp-implementation-type)
              (lisp-implementation-version)
              (software-type)
              (machine-type)
              (software-version))
      (let ((*package* (find-package :keyword)))
        (pprint `(defsystem ,name-keyword
                     :class prebuilt-system
                     :components ((:compiled-file ,(pathname-name fasl)))
                     :lib ,(make-pathname :name (pathname-name library)
                                          :type (pathname-type library)))
                s)))))

#-(or ecl mkcl)
(defmethod perform ((o bundle-op) (c system))
  (let* ((input-files (input-files o c))
         (fasl-files (remove (fasl-type) input-files :key #'pathname-type :test-not #'string=))
         (non-fasl-files (remove (fasl-type) input-files :key #'pathname-type :test #'string=))
         (output-files (output-files o c))
         (output-file (first output-files)))
    (when input-files
      (assert output-files)
      (when non-fasl-files
        (error "On ~A, asdf-bundle can only bundle FASL files, but these were also produced: ~S"
               (implementation-type) non-fasl-files))
      (when (and (typep o 'monolithic-bundle-op)
                 (or (monolithic-op-prologue-code o) (monolithic-op-epilogue-code o)))
        (error "prologue-code and epilogue-code are not supported on ~A"
               (implementation-type)))
      (with-staging-pathname (output-file)
        (combine-fasls fasl-files output-file)))))

(defmethod output-files ((o fasl-op) (c source-file))
  (declare (ignorable o c))
  nil)

(defmethod input-files ((o fasl-op) (c source-file))
  (declare (ignorable o c))
  nil)

(defgeneric* system-fasl (system))
(defmethod system-fasl ((system precompiled-system))
  (let* ((f (%system-fasl system))
         (p (etypecase f
              ((or pathname string) f)
              (function (funcall f))
              (cons (eval f)))))
    (pathname p)))

(defmethod input-files ((o load-op) (s precompiled-system))
  (declare (ignorable o))
  (list (system-fasl s)))

(defmethod component-depends-on ((o load-fasl-op) (s precompiled-system))
  (declare (ignorable o))
  `((load-op ,s) ,@(call-next-method)))

#| ;; Example use:
(asdf:defsystem :precompiled-asdf-utils :class asdf::precompiled-system :fasl (asdf:apply-output-translations (asdf:system-relative-pathname :asdf-utils "asdf-utils.system.fasl")))
(asdf:load-system :precompiled-asdf-utils)
|#

#+ecl
(defmethod output-files ((o fasl-op) (c system))
  (declare (ignorable o c))
  (loop :for file :in (call-next-method)
        :collect (make-pathname :type "fasb" :defaults file)))

#+ecl
(defmethod perform ((o bundle-op) (c system))
  (let* ((object-files (remove "fas" (input-files o c)
                               :key #'pathname-type :test #'string=))
         (output (output-files o c)))
    (apply #'c::builder (bundle-op-type o) (first output)
           :lisp-files (append object-files (bundle-op-lisp-files o))
           (append (bundle-op-build-args o)
                   (when (and (typep o 'monolithic-bundle-op)
                              (monolithic-op-prologue-code o))
                     `(:prologue-code ,(monolithic-op-prologue-code o)))
                   (when (and (typep o 'monolithic-bundle-op)
                              (monolithic-op-epilogue-code o))
                     `(:epilogue-code ,(monolithic-op-epilogue-code o)))))))

#+mkcl
(progn
;;;
;;; BUNDLE-SUB-OPERATIONS
;;;
;;; Builds a list of pairs (operation . component) which contains all the
;;; dependencies of this bundle.
;;;

(defun* mkcl-bundle-sub-operations (op sys)
  (gather-components (find-operation op 'compile-op) sys
                     :other-systems nil
                     :filter-type '(not system)))

(defun* files-to-bundle (operation system)
  (loop :for (o . c) :in (mkcl-bundle-sub-operations operation system)
    :for sub-files = (output-files o c)
    :when sub-files :collect (first sub-files)))

(defmethod component-depends-on ((o bundle-op) (c system))
  (declare (ignorable o))
  `((compile-op ,c) ,@(call-next-method)))

(defmethod output-files ((o bundle-op) (c system))
  (let* ((name (component-name c))
         (static-lib-name (merge-pathnames
                           (compiler::builder-internal-pathname name :static-library)
                           (component-relative-pathname c)))
         (fasl-bundle-name (merge-pathnames
                            (compiler::builder-internal-pathname name :fasb)
                            (component-relative-pathname c))))
    (list static-lib-name fasl-bundle-name)))

(defmethod perform ((o bundle-op) (c system))
  (let ((object-files (files-to-bundle o c))
        (output (output-files o c)))
    (when (bundle-op-do-static-library-p o)
      (apply #'compiler::build-static-library (first output)
             :lisp-object-files object-files (bundle-op-build-args o)))
    (when (bundle-op-do-fasb-p o)
      (apply #'compiler::build-bundle (second output)
             :lisp-object-files object-files (bundle-op-build-args o)))))

(defun* bundle-system (system &rest args &key force (verbose t) version &allow-other-keys)
  (declare (ignore force verbose version))
  (apply #'operate 'bundle-op system args))
);mkcl

#+(or ecl mkcl)
(defun* register-pre-built-system (name)
  (register-system (make-instance 'system :name (coerce-name name) :source-file nil)))