2.23.4: small refactoring of ECL / MKCL support after latest MKCL merge.

Tested: CCL, ECL, SBCL.

diff --git a/asdf-ecl.lisp b/asdf-ecl.lisp
index 5242a82..657db7a 100644 (file)
--- a/asdf-ecl.lisp
+++ b/asdf-ecl.lisp
@@ -1,5 +1,5 @@
 ;;; Copyright (c) 2005 - 2007, Michael Goffioul (michael dot goffioul at swing dot be)
-;;; Copyright (c) 2008 - 2011, Juan Jose Garcia Ripoll
+;;; Copyright (c) 2008 - 2012, Juan Jose Garcia Ripoll
 ;;;
 ;;;   This program is free software; you can redistribute it and/or
 ;;;   modify it under the terms of the GNU Library General Public
@@ -171,9 +171,9 @@
   (list (cons (make-instance 'lib-op) c)))
 
 (defmethod component-depends-on ((o bundle-op) (c system))
-  (loop for (op . dep) in (bundle-sub-operations o c)
-     when (typep dep 'system)
-     collect (list (class-name (class-of op))
+  (loop :for (op . dep) :in (bundle-sub-operations o c)
+    :when (typep dep 'system)
+    :collect (list (class-name (class-of op))
                    (component-name dep))))
 
 (defmethod component-depends-on ((o lib-op) (c system))
@@ -185,8 +185,8 @@
   nil)
 
 (defmethod input-files ((o bundle-op) (c system))
-  (loop for (sub-op . sub-c) in (bundle-sub-operations o c)
-     nconc (output-files sub-op sub-c)))
+  (loop :for (sub-op . sub-c) :in (bundle-sub-operations o c)
+    :nconc (output-files sub-op sub-c)))
 
 (defmethod output-files ((o bundle-op) (c system))
   (let ((name (concatenate 'base-string (component-name c)
@@ -196,8 +196,8 @@
 
 (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)))
+  (loop :for file :in (call-next-method)
+    :collect (make-pathname :type "fasb" :defaults file)))
 
 (defmethod perform ((o bundle-op) (c t))
   (declare (ignorable o c))
@@ -250,16 +250,16 @@
          (files (and system (output-files operation system))))
     (if (or move-here (and (null move-here-p)
                            (member operation-name '(:program :binary))))
-        (loop with dest-path = (truename (ensure-directories-exist move-here-path))
-           for f in files
-           for new-f = (make-pathname :name (pathname-name f)
+        (loop :with dest-path = (truename (ensure-directories-exist move-here-path))
+          :for f in files
+          :for new-f = (make-pathname :name (pathname-name f)
                                       :type (pathname-type f)
                                       :defaults dest-path)
-           do (progn
+          :do (progn
                 (when (probe-file new-f)
                   (delete-file new-f))
                 (rename-file f new-f))
-           collect new-f)
+           :collect new-f)
         files)))
 
 ;;;
@@ -293,8 +293,8 @@
   (let ((l (input-files o c)))
     (and l
          (load (first l))
-         (loop for i in (module-components c)
-            do (setf (gethash 'load-op (component-operation-times i))
+         (loop :for i :in (module-components c)
+           :do (setf (gethash 'load-op (component-operation-times i))
                      (get-universal-time))))))
 
 ;;;
@@ -374,19 +374,19 @@
                 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)))
+  (loop :for dep :in (binary-op-dependencies o s)
+    :append (apply #'component-depends-on dep)))
 
 (defmethod input-files ((o binary-op) (s system))
-  (loop for dep in (binary-op-dependencies o s)
-     append (apply #'input-files dep)))
+  (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))))
+         (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))
@@ -395,8 +395,8 @@
          (filename (first (output-files o s)))
          (name (component-name s))
          (name-keyword (intern (string name) (find-package :keyword))))
-    (loop for dep in dependencies
-       do (apply #'perform dep))
+    (loop :for dep :in dependencies
+      :do (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)
@@ -419,7 +419,6 @@
 ;;;
 
 (export '(make-build load-fasl-op prebuilt-system))
-(push '("fasb" . si::load-binary) ext:*load-hooks*)
 
 (defun register-pre-built-system (name)
   (register-system (make-instance 'system :name (coerce-name name) :source-file nil)))
@@ -431,7 +430,3 @@
                      (let ((l (multiple-value-list (funcall f name))))
                        (and (first l) (register-pre-built-system name))
                        (values-list l)))))
-#+win32
-(unless (assoc "asd" ext:*load-hooks* :test 'equal)
-  (appendf ext:*load-hooks* '(("asd" . si::load-source))))
-

diff --git a/asdf.asd b/asdf.asd
index abf73d2..d06e703 100644 (file)
--- a/asdf.asd
+++ b/asdf.asd
@@ -14,7 +14,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.23.3" ;; to be automatically updated by bin/bump-revision
+  :version "2.23.4" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components
   ((:file "asdf")

diff --git a/asdf.lisp b/asdf.lisp
index 29ca7bb..f2ed161 100644 (file)
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,5 +1,5 @@
 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.23.3: Another System Definition Facility.
+;;; This is ASDF 2.23.4: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
@@ -118,7 +118,7 @@
          ;; "2.345.6" would be a development version in the official upstream
          ;; "2.345.0.7" would be your seventh local modification of official release 2.345
          ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
-         (asdf-version "2.23.3")
+         (asdf-version "2.23.4")
          (existing-asdf (find-class 'component nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -2498,8 +2498,15 @@ recursive calls to traverse.")
 
 (defmethod output-files ((operation compile-op) (c cl-source-file))
   (declare (ignorable operation))
-  (let ((p (lispize-pathname (component-pathname c))))
-    (list (compile-file-pathname p))))
+  (let* ((p (lispize-pathname (component-pathname c)))
+         (f (compile-file-pathname ;; fasl
+             p #+mkcl :fasl-p #+mkcl t #+ecl :type #+ecl :fasl))
+         #+mkcl (o (compile-file-pathname p :fasl-p nil))) ;; object file
+    #+ecl (if (use-ecl-byte-compiler-p)
+              (list f)
+              (list (compile-file-pathname p :type :object) f))
+    #+mkcl (list o f)
+    #-(or ecl mkcl) (list f)))
 
 (defmethod perform ((operation compile-op) (c static-file))
   (declare (ignorable operation c))
@@ -2540,7 +2547,13 @@ recursive calls to traverse.")
         (perform (make-sub-operation c o c 'compile-op) c)))))
 
 (defmethod perform ((o load-op) (c cl-source-file))
-  (map () #'load (input-files o c)))
+  (map () #'load
+       #-(or ecl mkcl)
+       (input-files o c)
+       #+(or ecl mkcl)
+       (loop :for i :in (input-files o c)
+            :unless (string= (pathname-type i) "fas")
+            :collect (compile-file-pathname (lispize-pathname i)))))
 
 (defmethod perform ((operation load-op) (c static-file))
   (declare (ignorable operation c))
@@ -4385,6 +4398,10 @@ with a different configuration, so the configuration would be re-read then."
 ;;;
 #+ecl
 (progn
+  #+win32
+  (unless (assoc "asd" ext:*load-hooks* :test 'equal)
+    (appendf ext:*load-hooks* '(("asd" . si::load-source))))
+
   (setf *compile-op-compile-file-function* 'ecl-compile-file)
 
   (defun ecl-compile-file (input-file &rest keys &key &allow-other-keys)
@@ -4397,25 +4414,9 @@ with a different configuration, so the configuration would be re-read then."
                                       :lisp-files (list object-file))
                        object-file)
                   flags1
-                  flags2))))
-
-  (defmethod output-files ((operation compile-op) (c cl-source-file))
-    (declare (ignorable operation))
-    (let* ((p (lispize-pathname (component-pathname c)))
-           (f (compile-file-pathname p :type :fasl)))
-      (if (use-ecl-byte-compiler-p)
-          (list f)
-          (list (compile-file-pathname p :type :object) f)))))
-
-(defmethod perform ((o load-op) (c cl-source-file))
-  (map () #'load
-       #-(or ecl mkcl)
-       (input-files o c)
-       #+(or ecl mkcl)
-       (loop :for i :in (input-files o c)
-            :unless (string= (pathname-type i) "fas")
-            :collect (compile-file-pathname (lispize-pathname i)))))
+                  flags2)))))
 
+;;; Same thing for MKCL
 #+mkcl
 (progn
   (setf *compile-op-compile-file-function* 'mkcl-compile-file)
@@ -4428,14 +4429,7 @@ with a different configuration, so the configuration would be re-read then."
                                        :lisp-object-files (list object-file))
                    object-file)
               flags1
-              flags2)))
-
-  (defmethod output-files ((operation compile-op) (c cl-source-file))
-    (declare (ignorable operation))
-    (let* ((p (lispize-pathname (component-pathname c)))
-           (f (compile-file-pathname p :fasl-p t))
-           (o (compile-file-pathname p :fasl-p nil)))
-      (list o f))))
+              flags2))))
 
 
 ;;;; -----------------------------------------------------------------