CLISP tweak. constituent-designator for NIL.

diff --git a/asdf-ops.lisp b/asdf-ops.lisp
index 9d1f3af..97e9db0 100644 (file)
--- a/asdf-ops.lisp
+++ b/asdf-ops.lisp
@@ -229,10 +229,8 @@ to the base of the system."
 ;;                      :cull-redundant cull-redundant
 ;;                      :debug-object-types debug-object-types
                       :base-pathname base-pathname))))))
-    #+clisp
-    (when (probe-file destination-file) (delete-file destination-file)) ;; Workaround BUG in CLISP 2.48, lose atomicity
-    #+clisp
-    (posix:copy-file tmp-file-name destination-file :method :rename :if-exists :overwrite)
+    #+clisp ;; But for a bug in CLISP 2.48, we should use :if-exists :overwrite and be atomic
+    (posix:copy-file tmp-file-name destination-file :method :rename)
     #-clisp
     (rename-file tmp-file-name destination-file
                  #+clozure :if-exists #+clozure :rename-and-delete)))
@@ -271,41 +269,6 @@ to the base of the system."
        (when system
          (push (first system) component-names))))))
 
-#|
-;; Old macro-ish version by antifuchs:
-(macrolet
-    ((define-comp-file-reader (fname (1-system-var return-var)
-                                     &body 1-system-body)
-         (let ((system-name (gensym))
-               (system-names (gensym))
-               (done-systems (gensym))
-               (systems (gensym)))
-           `(defun ,fname (pathname &rest ,system-names)
-              (with-open-file (f pathname :direction :input)
-                (let ((,systems (read f))
-                      ,done-systems
-                      ,return-var)
-                  (labels ((do-1-system (,system-name)
-                             (unless (position ,system-name ,done-systems
-                                               :test #'string-equal)
-                               (let ((,1-system-var (assoc ,system-name ,systems
-                                                           :test #'string-equal)))
-                                 (progn ,@1-system-body)
-                                 (push ,system-name ,done-systems)
-                                 (getf (cdr ,1-system-var) :depends-on)))))
-                    (loop :while ,system-names :do
-                      (let ((,system-name (pop ,system-names)))
-                        (setf ,system-names (append ,system-names
-                                                    (do-1-system ,system-name)))))
-                    ,return-var)))))))
-  (define-comp-file-reader read-component-file (system component-list)
-    (setf component-list
-          (append component-list (getf (cdr system) :components))))
-  (define-comp-file-reader systems-in-configuration (system component-names)
-    (when system
-      (push (first system) component-names))))
-|#
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; ;; Unused.

diff --git a/classes.lisp b/classes.lisp
index adae11a..ff1af1f 100644 (file)
--- a/classes.lisp
+++ b/classes.lisp
@@ -265,6 +265,12 @@
 (defgeneric constituent-designator (con)
   (:documentation "Return the unique designator of the constituent."))
 
+(defmethod constituent-designator ((con null))
+  nil)
+
+(defmethod constituent-designator ((con top-constituent))
+  t)
+
 (defmethod constituent-designator ((con constituent))
   (list* (class-of con) (constituent-index con)
          (constituent-designator (constituent-parent con))))
@@ -273,9 +279,6 @@
   (list* :form (constituent-index con)
          (constituent-designator (constituent-parent con))))
 
-(defmethod constituent-designator ((con top-constituent))
-  nil)
-
 (defmethod constituent-designator ((con asdf-component-constituent))
   (list* :asdf
          (asdf:component-pathname (asdf-component-constituent-component con))