Commit 173de3d5 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

CLISP tweak. constituent-designator for NIL.

parent e49c446c
......@@ -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.
......
......@@ -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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment