;; -*- lisp -*-

(in-package :it.bese.arnesi)

;;;; * ASDF extras

;;;; ** CLEAN-OP - An intelligent make clean for ASDF

(defclass clean-op (asdf:operation)
  ((for-op :accessor for-op :initarg :for-op :initform 'asdf:compile-op))
  (:documentation "Removes any files generated by an asdf component."))

(defmethod asdf:perform ((op clean-op) (c asdf:component))
  "Delete all the output files generated by the component C."
  (dolist (f (asdf:output-files (make-instance (for-op op)) c))
    (when (probe-file f)
      (delete-file f))))

(defmethod asdf:operation-done-p ((op clean-op) (c asdf:component))
  "Returns T when the output-files of (for-op OP) C don't exist."
  (dolist (f (asdf:output-files (make-instance (for-op op)) c))
    (when (probe-file f) (return-from asdf:operation-done-p nil)))
  t)

;;;; ** Creating a single .fas or .fasl file

;;;; Instead of creating images another way to distribute systems is
;;;; to create a single compiled file containing all the code. This is
;;;; only possible on some lisps, sbcl and clisp are the only ones
;;;; supported for now.

;;;; NB: Unlike the CLEAN-OP this is experimental (its now to have
;;;; problems on multiple systems with non-trivial dependencies).

(defun make-single-fasl (system-name
                         &key (op (make-instance 'asdf:load-op))
                              output-file)
  (let* ((system (asdf:find-system system-name))
         (steps (asdf::traverse op system))
         (output-file (or output-file
                          (compile-file-pathname
                           (make-pathname
                            :name (asdf:component-name system)
                            :defaults (asdf:component-pathname system)))))
         (*buffer* (make-array 4096 :element-type '(unsigned-byte 8)
                                    :adjustable t)))
    (declare (special *buffer*))
    (with-output-to-file (*fasl* output-file
                          :if-exists :error
                          :element-type '(unsigned-byte 8))
      (declare (special *fasl*))
      (dolist (s steps)
        (process-step (car s) (cdr s) output-file)))))

(defgeneric process-step (op comp output-file))

(defmethod process-step
    ((op asdf:load-op) (file asdf:cl-source-file) output-file)
  (declare (ignore output-file)
           (special *buffer* *fasl*))
  (dolist (fasl (asdf:output-files (make-instance 'asdf:compile-op) file))
    (with-input-from-file (input (truename fasl)
                           :element-type '(unsigned-byte 8))
      (setf *buffer* (adjust-array *buffer* (file-length input)))
      (read-sequence *buffer* input)
      (write-sequence *buffer* *fasl*))))

(defmethod process-step ((op asdf:operation) (comp asdf:component) output-file)
  (declare (ignore output-file))
  (format t "Ignoring step ~S on ~S.~%" op comp))

;; Copyright (c) 2002-2003, Edward Marco Baringer
;; All rights reserved. 
;; 
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are
;; met:
;; 
;;  - Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 
;;  - Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;;  - Neither the name of Edward Marco Baringer, nor BESE, nor the names
;;    of its contributors may be used to endorse or promote products
;;    derived from this software without specific prior written permission.
;; 
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.