;;; -*- Mode: Lisp ; Syntax: ANSI-Common-Lisp -*-

#+xcvb (module (:depends-on ("bundle")))

(in-package :asdf)

(declaim (optimize (debug 3) (safety 3) (speed 1)))

(defun concatenate-files (inputs output)
  (let ((infiles (mapcar #'sb-ext:native-namestring inputs))
        (outfile (sb-ext:native-namestring output)))
    (assert
     (= 0 (sb-ext:process-exit-code 
           #+win32
           (sb-ext:run-program
            "copy" `("/b" ,@(loop :for (i . morep) :on infiles
                                  :collect i :when morep :collect "+") ,output)
            :input nil :output nil :error nil :wait t)
           #-win32
           (sb-ext:run-program
            "cat" infiles :output outfile
            :if-output-exists :supersede :external-format :latin1
            :input nil :error nil :search t :wait t))))))

(defun combine-fasls (inputs outputs)
  (assert (length=n-p outputs 1))
  (ensure-directories-exist (first outputs))
  (concatenate-files inputs (first outputs)))

(defmethod perform ((o bundle-op) (c system))
  (let* ((input-files (input-files o c))
         (fasl-files (remove "fasl" input-files :key #'pathname-type :test-not #'string=))
         (non-fasl-files (remove "fasl" 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 SBCL, asdf-bundle can only bundle FASL files, but these were also produced: ~S" 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 SBCL"))
      (ensure-directories-exist output-file)
      (combine-fasls fasl-files output-files))))


;;; On SBCL, everything happens in the lib-op dependency
(defmethod output-files ((o fasl-op) (c component))
  (declare (ignorable o c))
  nil)

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