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