From b166c1edf25b880f1e3e28bd65f02c0b5e53d067 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Sun, 18 Sep 2016 20:46:25 -0400 Subject: [PATCH] Update comments and docstrings in find-system.lisp --- find-system.lisp | 64 +++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 52 insertions(+), 12 deletions(-) diff --git a/find-system.lisp b/find-system.lisp index 084d133fa..f655d37f7 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -225,6 +225,8 @@ Returns T if system was or is now undefined, NIL if a new preloaded system was r (not (ensure-preloaded-system-registered name)))) (defun clear-defined-systems () + "Clear all currently registered defined systems. +Preloaded systems (including immutable ones) will be reset, other systems will be de-registered." (loop :for name :being :the :hash-keys :of *defined-systems* :unless (equal name "asdf") :do (clear-system name))) @@ -236,28 +238,41 @@ Returns T if system was or is now undefined, NIL if a new preloaded system was r FN should be a function of one argument. It will be called with an object of type asdf:system." (loop :for registered :being :the :hash-values :of *defined-systems* - :do (funcall fn (cdr registered))))) + :do (funcall fn (cdr registered)))) -;;; for the sake of keeping things reasonably neat, we adopt a -;;; convention that functions in this list are prefixed SYSDEF- -(with-upgradability () - (defvar *system-definition-search-functions* '()) + ;;; Searching for system definitions + + ;; For the sake of keeping things reasonably neat, we adopt a convention that + ;; only symbols are to be pushed to this list (rather than e.g. function objects), + ;; which makes upgrade easier. Also, the name of these symbols shall start with SYSDEF- + (defvar *system-definition-search-functions* '() + "A list that controls the ways that ASDF looks for system definitions. +It contains symbols to be funcalled in order, with a requested system name as argument, +until one returns a non-NIL result (if any), which must then be a fully initialized system object +with that name.") + + ;; Initialize and/or upgrade the *system-definition-search-functions* + ;; so it doesn't contain obsolete symbols, and does contain the current ones. (defun cleanup-system-definition-search-functions () (setf *system-definition-search-functions* (append ;; Remove known-incompatible sysdef functions from old versions of asdf. - (remove-if #'(lambda (x) (member x '(contrib-sysdef-search sysdef-find-asdf sysdef-preloaded-system-search))) - *system-definition-search-functions*) + ;; Order matters, so we can't just use set-difference. + (let ((obsolete + '(contrib-sysdef-search sysdef-find-asdf sysdef-preloaded-system-search))) + (remove-if #'(lambda (x) (member x obsolete)) *system-definition-search-functions*)) ;; Tuck our defaults at the end of the list if they were absent. ;; This is imperfect, in case they were removed on purpose, - ;; but then it will be the responsibility of whoever does that + ;; but then it will be the responsibility of whoever removes these symmbols ;; to upgrade asdf before he does such a thing rather than after. (remove-if #'(lambda (x) (member x *system-definition-search-functions*)) '(sysdef-central-registry-search sysdef-source-registry-search))))) (cleanup-system-definition-search-functions) + ;; This (private) function does the search for a system definition using *s-d-s-f*; + ;; it is to be called by locate-system. (defun search-for-system-definition (system) ;; Search for valid definitions of the system available in the current session. ;; Previous definitions as registered in *defined-systems* MUST NOT be considered; @@ -272,6 +287,11 @@ called with an object of type asdf:system." (try 'sysdef-immutable-system-search) (map () #'try *system-definition-search-functions*)))) + + ;;; The legacy way of finding a system: the *central-registry* + + ;; This variable contains a list of directories to be lazily searched for the requested asd + ;; by sysdef-central-registry-search. (defvar *central-registry* nil "A list of 'system directory designators' ASDF uses to find systems. @@ -283,10 +303,13 @@ which evaluates to a pathname. For example: #p\"/home/me/cl/systems/\" #p\"/usr/share/common-lisp/systems/\")) -This is for backward compatibility. -Going forward, we recommend new users should be using the source-registry. -") +This variable is for backward compatibility. +Going forward, we recommend new users should be using the source-registry.") + ;; Function to look for an asd file of given NAME under a directory provided by DEFAULTS. + ;; Return the truename of that file if it is found and TRUENAME is true. + ;; Return NIL if the file is not found. + ;; On Windows, follow shortcuts to .asd files. (defun probe-asd (name defaults &key truename) (block nil (when (directory-pathname-p defaults) @@ -309,6 +332,7 @@ Going forward, we recommend new users should be using the source-registry. (when (probe-file* shortcut) (ensure-pathname (parse-windows-shortcut shortcut) :namestring :native))))))))) + ;; Function to push onto *s-d-s-f* to use the *central-registry* (defun sysdef-central-registry-search (system) (let ((name (primary-system-name system)) (to-remove nil) @@ -356,10 +380,15 @@ Going forward, we recommend new users should be using the source-registry. (list new) (subseq *central-registry* (1+ position)))))))))) + + ;;; Methods for find-system + + ;; Reject NIL as a system designator. (defmethod find-system ((name null) &optional (error-p t)) (when error-p (sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>")))) + ;; Default method for find-system: resolve the argument using COERCE-NAME. (defmethod find-system (name &optional (error-p t)) (find-system (coerce-name name) error-p)) @@ -376,7 +405,10 @@ Going forward, we recommend new users should be using the source-registry. (defun load-asd (pathname &key name (external-format (encoding-external-format (detect-encoding pathname))) &aux (readtable *readtable*) (print-pprint-dispatch *print-pprint-dispatch*)) - ;; Tries to load system definition with canonical NAME from PATHNAME. + "Load systems definitions from PATHNAME. +NAME if supplied is the name of a system expected to be defined in that file. + +Do NOT try to load a .asd file directly with CL:LOAD. Always use ASDF:LOAD-ASD." (with-asdf-cache () (with-standard-io-syntax (let ((*package* (find-package :asdf-user)) @@ -401,6 +433,9 @@ Going forward, we recommend new users should be using the source-registry. (defvar *old-asdf-systems* (make-hash-table :test 'equal)) + ;; (Private) function to check that a system that was found isn't an asdf downgrade. + ;; Returns T if everything went right, NIL if the system was an ASDF of the same or older version, + ;; that shall not be loaded. Also issue a warning if it was a strictly older version of ASDF. (defun check-not-old-asdf-system (name pathname) (or (not (equal name "asdf")) (null pathname) @@ -475,6 +510,11 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (setf found-system nil pathname nil)) (values foundp found-system pathname previous previous-time)))) + ;; Main method for find-system: first, make sure the computation is memoized in a session cache. + ;; unless the system is immutable, use locate-system to find the primary system; + ;; reconcile the finding (if any) with any previous definition (in a previous session, + ;; preloaded, with a previous configuration, or before filesystem changes), and + ;; load a found .asd if appropriate. Finally, update registration table and return results. (defmethod find-system ((name string) &optional (error-p t)) (with-asdf-cache (:key `(find-system ,name)) (let ((primary-name (primary-system-name name))) -- GitLab