Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
A
asdf
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Tarn Burton
asdf
Commits
b166c1ed
Commit
b166c1ed
authored
8 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Patches
Plain Diff
Update comments and docstrings in find-system.lisp
parent
1b53e3c0
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
find-system.lisp
+52
-12
52 additions, 12 deletions
find-system.lisp
with
52 additions
and
12 deletions
find-system.lisp
+
52
−
12
View file @
b166c1ed
...
...
@@ -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
)))
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment