Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Mark Evenson
asdf
Commits
32a579df
Commit
32a579df
authored
May 15, 2020
by
Francois-Rene Rideau
Committed by
Robert Goldman
Jun 03, 2021
Browse files
Ensure upgradability without DEFUN*
parent
3bb042cb
Changes
11
Hide whitespace changes
Inline
Side-by-side
action.lisp
View file @
32a579df
...
...
@@ -132,7 +132,7 @@ Use it in FORMAT control strings as ~/asdf-action:format-action/"
;;;; Detection of circular dependencies
(
with-upgradability
()
(
defun
(
action-valid-p
)
(
operation
component
)
(
defun
action-valid-p
(
operation
component
)
"Is this action valid to include amongst dependencies?"
;; If either the operation or component was resolved to nil, the action is invalid.
;; :if-feature will invalidate actions on components for which the features don't apply.
...
...
output-translations.lisp
View file @
32a579df
...
...
@@ -194,7 +194,7 @@ and the order is by decreasing length of namestring of the source pathname.")
(
when
inherit
(
process-output-translations
(
first
inherit
)
:collect
collect
:inherit
(
rest
inherit
))))
(
defun
*
(
process-output-translations-directive
)
(
directive
&key
inherit
collect
)
(
defun
process-output-translations-directive
(
directive
&key
inherit
collect
)
(
if
(
atom
directive
)
(
ecase
directive
((
:enable-user-cache
)
...
...
@@ -287,7 +287,7 @@ effectively disabling the output translation facility."
;; Top-level entry-point to _use_ output-translations
(
defun
*
(
apply-output-translations
)
(
path
)
(
defun
apply-output-translations
(
path
)
(
etypecase
path
(
logical-pathname
path
)
...
...
parse-defsystem.lisp
View file @
32a579df
...
...
@@ -148,7 +148,8 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~
;; Given a form used as :version specification, in the context of a system definition
;; in a file at PATHNAME, for given COMPONENT with given PARENT, normalize the form
;; to an acceptable ASDF-format version.
(
defun*
(
normalize-version
)
(
form
&key
pathname
component
parent
)
(
fmakunbound
'normalize-version
)
;; signature changed between 2.27 and 2.31
(
defun
normalize-version
(
form
&key
pathname
component
parent
)
(
labels
((
invalid
(
&optional
(
continuation
"using NIL instead"
))
(
warn
(
compatfmt
"~@<Invalid :version specifier ~S~@[ for component ~S~]~@[ in ~S~]~@[ from file ~S~]~@[, ~A~]~@:>"
)
form
component
parent
pathname
continuation
))
...
...
@@ -293,11 +294,11 @@ COMPONENTS is a list of the explicitly defined children descriptions.
SERIAL-P is non-NIL if each child in COMPONENTS should depend on the previous
children."
))
(
defun
*
stable-union
(
s1
s2
&key
(
test
#'
eql
)
(
key
'identity
))
(
defun
stable-union
(
s1
s2
&key
(
test
#'
eql
)
(
key
'identity
))
(
append
s1
(
remove-if
#'
(
lambda
(
e2
)
(
member
(
funcall
key
e2
)
(
funcall
key
s1
)
:test
test
))
s2
)))
(
defun
*
(
parse-component-form
)
(
parent
options
&key
previous-serial-components
)
(
defun
(
parse-component-form
)
(
parent
options
&key
previous-serial-components
)
(
destructuring-bind
(
type
name
&rest
rest
&key
(
builtin-system-p
()
bspp
)
...
...
plan.lisp
View file @
32a579df
...
...
@@ -224,7 +224,7 @@ to be meaningful, or could it just as well have been done in another Lisp image?
;;;; Visiting dependencies of an action and computing action stamps
(
with-upgradability
()
(
defun
*
(
map-direct-dependencies
)
(
operation
component
fun
)
(
defun
map-direct-dependencies
(
operation
component
fun
)
"Call FUN on all the valid dependencies of the given action in the given plan"
(
loop
:for
(
dep-o-spec
.
dep-c-specs
)
:in
(
component-depends-on
operation
component
)
:for
dep-o
=
(
find-operation
operation
dep-o-spec
)
...
...
@@ -234,7 +234,7 @@ to be meaningful, or could it just as well have been done in another Lisp image?
:when
(
action-valid-p
dep-o
dep-c
)
:do
(
funcall
fun
dep-o
dep-c
))))
(
defun
*
(
reduce-direct-dependencies
)
(
operation
component
combinator
seed
)
(
defun
reduce-direct-dependencies
(
operation
component
combinator
seed
)
"Reduce the direct dependencies to a value computed by iteratively calling COMBINATOR
for each dependency action on the dependency's operation and component and an accumulator
initialized with SEED."
...
...
@@ -243,7 +243,7 @@ initialized with SEED."
#'
(
lambda
(
dep-o
dep-c
)
(
setf
seed
(
funcall
combinator
dep-o
dep-c
seed
))))
seed
)
(
defun
*
(
direct-dependencies
)
(
operation
component
)
(
defun
direct-dependencies
(
operation
component
)
"Compute a list of the direct dependencies of the action within the plan"
(
reverse
(
reduce-direct-dependencies
operation
component
#'
acons
nil
)))
...
...
@@ -527,7 +527,7 @@ Update the VISITED-ACTIONS table with the known status, but don't add anything t
:do
(
collect-action-dependencies
plan
(
action-operation
action
)
(
action-component
action
)))
(
plan-actions
plan
)))
(
defun
*
(
required-components
)
(
system
&rest
keys
&key
(
goal-operation
'load-op
)
&allow-other-keys
)
(
defun
required-components
(
system
&rest
keys
&key
(
goal-operation
'load-op
)
&allow-other-keys
)
"Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and
return a list of the components involved in building the desired action."
(
with-asdf-session
(
:override
t
)
...
...
source-registry.lisp
View file @
32a579df
...
...
@@ -233,11 +233,11 @@ after having found a .asd file? True by default.")
(
defgeneric
process-source-registry
(
spec
&key
inherit
register
))
(
defun
*
(
inherit-source-registry
)
(
inherit
&key
register
)
(
defun
inherit-source-registry
(
inherit
&key
register
)
(
when
inherit
(
process-source-registry
(
first
inherit
)
:register
register
:inherit
(
rest
inherit
))))
(
defun
*
(
process-source-registry-directive
)
(
directive
&key
inherit
register
)
(
defun
process-source-registry-directive
(
directive
&key
inherit
register
)
(
destructuring-bind
(
kw
&rest
rest
)
(
if
(
consp
directive
)
directive
(
list
directive
))
(
ecase
kw
((
:include
)
...
...
system.lisp
View file @
32a579df
...
...
@@ -186,10 +186,11 @@ the primary one."
(
slot-value
(
find-system
(
primary-system-name
system
))
slot-name
))))
(
defmacro
define-system-virtual-slot-reader
(
slot-name
)
`
(
defun*
,
(
intern
(
concatenate
'string
(
string
:system-
)
(
string
slot-name
)))
(
system
)
(
system-virtual-slot-value
system
',slot-name
)))
(
let
((
name
(
intern
(
strcat
(
string
:system-
)
(
string
slot-name
)))))
`
(
progn
(
fmakunbound
',name
)
;; These were gf from defgeneric before 3.3.2.11
(
declaim
(
notinline
,
name
))
(
defun
,
name
(
system
)
(
system-virtual-slot-value
system
',slot-name
)))))
(
defmacro
define-system-virtual-slot-readers
()
`
(
progn
,@
(
mapcar
(
lambda
(
slot-name
)
`
(
define-system-virtual-slot-reader
,
slot-name
))
...
...
@@ -214,7 +215,7 @@ the primary one."
in which the system specification (.asd file) is located."
(
pathname-directory-pathname
(
system-source-file
system-designator
)))
(
defun
*
(
system-relative-pathname
)
(
system
name
&key
type
)
(
defun
system-relative-pathname
(
system
name
&key
type
)
"Given a SYSTEM, and a (Unix-style relative path) NAME of a file (or directory) of given TYPE,
return the absolute pathname of a corresponding file under that system's source code pathname."
(
subpathname
(
system-source-directory
system
)
name
:type
type
))
...
...
uiop/configuration.lisp
View file @
32a579df
...
...
@@ -215,7 +215,7 @@ directive.")
(
declaim
(
ftype
(
function
(
t
&key
(
:directory
boolean
)
(
:wilden
boolean
)
(
:ensure-directory
boolean
))
t
)
resolve-location
))
(
defun
*
(
resolve-location
)
(
x
&key
ensure-directory
wilden
directory
)
(
defun
resolve-location
(
x
&key
ensure-directory
wilden
directory
)
"Resolve location designator X into a PATHNAME"
;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory
(
loop
:with
dirp
=
(
or
directory
ensure-directory
)
...
...
uiop/lisp-build.lisp
View file @
32a579df
...
...
@@ -662,7 +662,7 @@ possibly in a different process. Otherwise just call THUNK."
(
defvar
*compile-check*
nil
"A hook for user-defined compile-time invariants"
)
(
defun
*
(
compile-file*
)
(
input-file
&rest
keys
(
defun
compile-file*
(
input-file
&rest
keys
&key
(
compile-check
*compile-check*
)
output-file
warnings-file
#+
clisp
lib-file
#+
(
or
clasp
ecl
mkcl
)
object-file
#+
sbcl
emit-cfasl
&allow-other-keys
)
...
...
uiop/pathname.lisp
View file @
32a579df
...
...
@@ -715,7 +715,7 @@ added to its DIRECTORY component. This is useful for output translations."
:defaults
pathname
)))
pathname
)))
(
defun
*
(
translate-pathname*
)
(
path
absolute-source
destination
&optional
root
source
)
(
defun
translate-pathname*
(
path
absolute-source
destination
&optional
root
source
)
"A wrapper around TRANSLATE-PATHNAME to be used by the ASDF output-translations facility.
PATH is the pathname to be translated.
ABSOLUTE-SOURCE is an absolute pathname to use as source for translate-pathname,
...
...
uiop/utility.lisp
View file @
32a579df
...
...
@@ -12,7 +12,6 @@
;; magic helper to define debugging functions:
#:uiop-debug
#:load-uiop-debug-utility
#:*uiop-debug-utility*
#:with-upgradability
;; (un)defining functions in an upgrade-friendly way
#:defun*
#:defgeneric*
#:nest
#:if-let
;; basic flow control
#:parse-body
;; macro definition helper
#:while-collecting
#:appendf
#:length=n-p
#:ensure-list
;; lists
...
...
@@ -41,27 +40,33 @@
(
in-package
:uiop/utility
)
;;;; Defining functions in a way compatible with hot-upgrade:
;; DEFUN* and DEFGENERIC* use FMAKUNBOUND to delete any previous fdefinition,
;; thus replacing the function without warning or error
;; even if the signature and/or generic-ness of the function has changed.
;; For a generic function, this invalidates any previous DEFMETHOD.
;; - The WTIH-UPGRADABILITY infrastructure below ensures that functions are declared NOTINLINE,
;; so that new definitions are always seen by all callers, even those up the stack.
;; - WITH-UPGRADABILITY also uses EVAL-WHEN so that definitions used by ASDF are in a limbo state
;; (especially for gf's) in between the COMPILE-OP and LOAD-OP operations on the defining file.
;; - THOU SHALT NOT redefine a function with a backward-incompatible semantics without renaming it.
;; - THOU SHALT change the name of a function whenever thou makest an incompatible change.
;; - For instance, when the meanings of NIL and T for timestamps was inverted,
;; functions in the STAMP<, STAMP<=, etc. family had to be renamed to TIMESTAMP<, TIMESTAMP<=, etc.,
;; because the change other caused a huge incompatibility during upgrade.
;; - Whenever a function goes from a DEFUN to a DEFGENERIC, or the DEFGENERIC signature changes, etc.,
;; even in a backward-compatible way, you MUST precede the definition by FMAKUNBOUND.
;; - Since FMAKUNBOUND will remove all the methods on the generic function, make sure that
;; all the methods required for ASDF to successfully continue compiling itself
;; shall be defined in the same file as the one with the FMAKUNBOUND.
;; - When a function goes from DEFGENERIC to DEFUN, you MAY have to use FMAKUNBOUND, too.
;; Please try the upgrade tests on all supported implementations and update this comment afterwards.
;; - For safety, you shall put the FMAKUNBOUND just before the DEFUN or DEFGENERIC,
;; in the same WITH-UPGRADABILITY form (and its implicit EVAL-WHEN).
;; - Any time you change a signature, please keep a comment specifying the first release after the change;
;; put that comment on the same line as FMAKUNBOUND, it you use FMAKUNBOUND.
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
defun
frob-defun/defgeneric
(
form
)
(
assert
(
member
(
first
form
)
'
(
defun
defgeneric
)))
(
let
((
name
(
second
form
)))
(
destructuring-bind
(
name
&key
(
supersede
t
))
(
if
(
or
(
atom
name
)
(
eq
(
car
name
)
'setf
))
(
list
name
:supersede
nil
)
name
)
(
declare
(
ignorable
supersede
))
`
(
progn
;; We usually try to do it only for the functions that need it,
;; which happens in asdf/upgrade - however, for ECL, we need this hammer.
,@
(
when
supersede
`
((
fmakunbound
',name
)))
,@
(
when
(
and
#+
(
or
clasp
ecl
)
(
symbolp
name
))
; fails for setf functions on ecl
`
((
declaim
(
notinline
,
name
))))
,
form
))))
(
defun
ensure-function-notinline
(
definition
&aux
(
name
(
second
definition
)))
(
assert
(
member
(
first
definition
)
'
(
defun
defgeneric
)))
`
(
progn
,
(
when
(
and
#+
(
or
clasp
ecl
)
(
symbolp
name
))
; NB: fails for (SETF functions) on ECL
`
(
declaim
(
notinline
,
name
)))
,
definition
))
(
defmacro
with-upgradability
((
&optional
)
&body
body
)
"Evaluate BODY at compile- load- and run- times, with DEFUN and DEFGENERIC modified
to also declare the functions NOTINLINE and to accept a wrapping the function name
...
...
@@ -72,7 +77,7 @@ to supersede any previous definition."
,@
(
loop
:for
form
:in
body
:collect
(
if
(
consp
form
)
(
case
(
first
form
)
((
defun
defgeneric
)
(
frob-defun/defgeneric
form
))
((
defun
defgeneric
)
(
ensure-function-notinline
form
))
(
otherwise
form
))
form
)))))
...
...
upgrade.lisp
View file @
32a579df
...
...
@@ -108,18 +108,28 @@ previously-loaded version of ASDF."
(
when-upgrading
()
(
let*
((
previous-version
(
first
*previous-asdf-versions*
))
(
redefined-functions
;; List of functions that changed incompatibly since 2.27:
;; gf signature changed (should NOT happen), defun that became a generic function,
;; method removed that will mess up with new ones (especially :around :before :after,
;; more specific or call-next-method'ed method) and/or semantics otherwise modified. Oops.
;; gf signature changed (should NOT happen), defun that became a generic function or
;; the other way around, method removed that will mess up with new ones
;; (especially :around :before :after, more specific or call-next-method'ed method)
;; and/or semantics otherwise modified. Oops.
;; NB: it's too late to do anything about functions in UIOP!
;; If you introduce some critical incompatibility there, you
must
change the function name.
;; If you introduce some critical incompatibility there, you
MUST
change the function name.
;; Note that we don't need do anything about functions that changed incompatibly
;; from ASDF 2.26 or earlier: we wholly punt on the entire ASDF package in such an upgrade.
;; Also note that we don't include the defgeneric=>defun, because they are
;; done directly with defun* and need not trigger a punt on data.
;; See discussion at https://gitlab.common-lisp.net/asdf/asdf/merge_requests/36
`
(
,@
(
when
(
version<
previous-version
"3.1.2"
)
'
(
#:component-depends-on
#:input-files
))
;; crucial methods *removed* before 3.1.2
,@
(
when
(
version<
previous-version
"3.1.7.20"
)
'
(
#:find-component
))))
;; and at https://gitlab.common-lisp.net/asdf/asdf/-/merge_requests/141
`
(
,@
(
when
(
version<
previous-version
"2.31"
)
'
(
#:normalize-version
))
;; pathname became &key
,@
(
when
(
version<
previous-version
"3.1.2"
)
'
(
#:component-depends-on
#:input-files
))
;; crucial methods *removed* before 3.1.2
,@
(
when
(
version<
previous-version
"3.1.7.20"
)
'
(
#:find-component
))
,@
(
when
(
version<
previous-version
"3.2.0"
)
'
(
#:required-components
))
; was a gf
,@
(
when
(
version<
previous-version
"3.3.0"
)
'
(
#:action-valid-p
#:map-direct-dependencies
;; were gfs with plan first
#:reduce-direct-dependencies
#:direct-dependencies
))
,@
(
when
(
version<
previous-version
"3.3.2.11"
)
;; were gfs
'
(
#:system-long-name
#:system-description
#:system-long-description
#:system-author
#:system-maintainer
#:system-mailto
#:system-homepage
#:system-source-control
#:system-licence
#:system-license
#:system-version
#:system-bug-tracker
))))
(
redefined-classes
;; redefining the classes causes interim circularities
;; with the old ASDF during upgrade, and many implementations bork
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment