Commit 6688d26b authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Introduce primary-system-p

Tweak primary-system-name to extract a component's system's primary-name.
primary-system-p recognizes only systems (not random component) and
strings that name them.
parent 1a253e2f
......@@ -256,9 +256,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(map () 'mark-component-preloaded (component-children component))
;; Mark the timestamps of the common lisp-action operations as 0.
(let ((times (component-operation-times component)))
(dolist (o `(,@(when (and (typep component 'system)
(equal (coerce-name component) (primary-system-name component)))
'(define-op))
(dolist (o `(,@(when (primary-system-p component) '(define-op))
prepare-op compile-op load-op))
(setf (gethash (make-operation o) times) 0))))))
......@@ -18,7 +18,7 @@
#:mailto #:system-mailto
#:long-name #:system-long-name
#:source-control #:system-source-control
#:coerce-name #:primary-system-name #:coerce-filename
#:coerce-name #:primary-system-name #:primary-system-p #:coerce-filename
#:find-system #:builtin-system-p)) ;; forward-reference, defined in find-system
(in-package :asdf/system)
......@@ -123,11 +123,21 @@ a SYMBOL (designing its name, downcased), or a STRING (designing itself)."
(string name)
(t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name))))
(defun primary-system-name (name)
(defun primary-system-name (system-designator)
"Given a system designator NAME, return the name of the corresponding primary system,
after which the .asd file is named. That's the first component when dividing the name
as a string by / slashes."
(first (split-string (coerce-name name) :separator "/")))
as a string by / slashes. A component designates its system."
(etypecase system-designator
(string (if-let (p (position #\/ system-designator))
(subseq system-designator 0 p) system-designator))
(component (primary-system-name (coerce-name (component-system system-designator))))))
(defun primary-system-p (system)
"Given a system designator SYSTEM, return T if it designates a primary system, or else NIL.
Also return NIL if system is neither a SYSTEM nor a string designating one."
(typecase system
(string (not (find #\/ system)))
(system (primary-system-p (coerce-name system)))))
(defun coerce-filename (name)
"Coerce a system designator NAME into a string suitable as a filename component.
......
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