Add support for LispWorks (wholly untested, probably needs tweaking).

diff --git a/asdf-bundle.asd b/asdf-bundle.asd
index 6bb46fb..5427b9f 100644 (file)
--- a/asdf-bundle.asd
+++ b/asdf-bundle.asd
@@ -10,7 +10,9 @@
 ;;; Copyright (c) 2008 - 2011, Juan Jose Garcia Ripoll
 ;;; Copyright (c) 2012 - 2012, Francois-Rene Rideau
 ;;;
-;;; Currently works on Allegro, Clozure CL, ECL, GNU CLISP, SBCL, maybe MKCL.
+;;; Currently works on
+;;; Allegro, Clozure CL, CMUCL, ECL, GNU CLISP, SBCL,
+;;; we think SCL (untested), maybe LispWorks (untested), MKCL (untested).
 ;;; For ABCL, see the abcl-jar contrib instead.
 
 (defsystem :asdf-bundle

diff --git a/asdf-bundle.lisp b/asdf-bundle.lisp
index 4043a4c..a9e3c7f 100644 (file)
--- a/asdf-bundle.lisp
+++ b/asdf-bundle.lisp
@@ -423,9 +423,31 @@ using WRITE-SEQUENCE and a sensibly sized buffer." ; copied from xcvb-driver
                                :direction :input :if-does-not-exist :error)
         (copy-stream-to-stream i o :element-type '(unsigned-byte 8))))))
 
+(defun* add-pathname-suffix (pathname suffix)
+  (make-pathname :name (strcat (pathname-name pathname) suffix)
+                 :defaults pathname))
+
 (defun combine-fasls (inputs output)
   #+clozure (ccl:fasl-concatenate output inputs :if-exists :supersede)
-  #+(or allegro clisp sbcl) (concatenate-files inputs output))
+  #+(or allegro clisp cmu sbcl scl) (concatenate-files inputs output)
+  #+lispworks
+  (let (fasls)
+    (unwind-protect
+         (progn
+           (loop :for i :in inputs
+                 :for n :from 1
+                 :for f = (add-pathname-suffix
+                           output (format nil "ASDF-TMP-~D" n))
+                 :do (lispworks:copy-file i f)
+                     (push f fasls))
+           (eval `(scm:defsystem :fasls-to-concatenate
+                    (:default-pathname ,(pathname-directory-pathname output)
+                     :load-only t)
+                    :members
+                    ,(loop :for f :in (reverse fasls)
+                           :collect `(,f :load-only t))))
+           (scm:concatenate-system output :fasls-to-concatenate))
+      (loop :for f :in fasls :do (delete-file f)))))
 
 (defun call-with-staging-pathname (pathname fun)
   "Calls fun with a staging pathname, and atomically
@@ -434,9 +456,7 @@ Note: this protects only against failure of the program,
 not against concurrent attempts.
 For the latter case, we ought pick random suffix and atomically open it."
   (let* ((pathname (pathname pathname))
-         (staging (make-pathname
-                   :name (strcat (pathname-name pathname) "-ASDF-TMP")
-                   :defaults pathname)))
+         (staging (add-pathname-suffix pathname "-ASDF-TMP")))
     (unwind-protect
          (multiple-value-prog1
              (funcall fun staging)