[cclan-list] ASDF on Lispworks

[Gary K. <gw...@me...>]

I proposed the following patch a long while back. It works around a  
problem Lispworks had when _re_ loading an ASDF system definition  
that used in-line component methods. There was no discussion the last  
time around. If there is still no discussion, then I will commit this  
early next week.

Index: asdf.lisp
===================================================================
RCS file: /cvsroot/cclan/asdf/asdf.lisp,v
retrieving revision 1.107
diff -u -w -u -r1.107 asdf.lisp
--- asdf.lisp	21 Mar 2007 22:08:33 -0000	1.107
+++ asdf.lisp	2 Jun 2007 02:39:05 -0000
@@ -108,6 +108,7 @@
	   )
    (:use :cl))
+
#+nil
(error "The author of this file habitually uses #+nil to comment out  
forms.  But don't worry, it was unlikely to work in the New  
Implementation of Lisp anyway")
@@ -129,6 +130,9 @@
(defvar *verbose-out* nil)
+(defparameter +asdf-methods+
+  '(perform explain output-files operation-done-p))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; utility stuff
@@ -1022,6 +1026,7 @@
(defvar *serial-depends-on*)
(defun parse-component-form (parent options)
+
    (destructuring-bind
	(type name &rest rest &key
	      ;; the following list of keywords is reproduced below in the
@@ -1032,6 +1037,7 @@
	      depends-on serial in-order-to
	      ;; list ends
	      &allow-other-keys) options
+    (declare (ignorable perform explain output-files operation-done-p))
      (check-component-input type name weakly-depends-on depends-on  
components in-order-to)
      (when (and parent
@@ -1094,22 +1100,29 @@
	       (load-op (load-op ,@depends-on))))
	    (slot-value ret 'do-first) `((compile-op (load-op ,@depends-on))))

-      (loop for (n v) in `((perform ,perform) (explain ,explain)
-			   (output-files ,output-files)
-			   (operation-done-p ,operation-done-p))
+      (%remove-component-inline-methods ret rest)
+
+      ret)))
+
+(defun %remove-component-inline-methods (ret rest)
+  (loop for name in +asdf-methods+
	    do (map 'nil
		    ;; this is inefficient as most of the stored
		    ;; methods will not be for this particular gf n
		    ;; But this is hardly performance-critical
-		    (lambda (m) (remove-method (symbol-function n) m))
-		    (component-inline-methods ret))
-	    when v
-	    do (destructuring-bind (op qual (o c) &body body) v
+	     (lambda (m)
+	       (remove-method (symbol-function name) m))
+	     (component-inline-methods ret)))
+  ;; clear methods, then add the new ones
+  (setf (component-inline-methods ret) nil)
+  (loop for name in +asdf-methods+
+     for v = (getf rest (intern (symbol-name name) :keyword))
+     when v do
+     (destructuring-bind (op qual (o c) &body body) v
		 (pushnew
-		  (eval `(defmethod ,n ,qual ((,o ,op) (,c (eql ,ret)))
+	(eval `(defmethod ,name ,qual ((,o ,op) (,c (eql ,ret)))
			  ,@body))
-		  (component-inline-methods ret))))
-      ret)))
+	(component-inline-methods ret)))))
(defun check-component-input (type name weakly-depends-on depends-on  
components in-order-to)
    "A partial test of the values of a component."

--
Gary Warren King, metabang.com
Cell: (413) 885 9127
Fax: (206) 338-4052
gwkkwg on Skype * garethsan on AIM