diff --git a/asdf-ops.lisp b/asdf-ops.lisp index 9d1f3af542a9c57e1abeb1cfdfaee44b435ae8aa..97e9db06816bc9522f97a980ff04a46ae0e3bef0 100644 --- 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 adae11a1155fec99d78d667b87c82abbe1c55f43..ff1af1f3ef702c50c22584f0246de4d106c2dfb1 100644 --- 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))