Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Jan Moringen
asdf
Commits
016d6bae
Commit
016d6bae
authored
Sep 11, 2016
by
Francois-Rene Rideau
Browse files
Make module provider wrapping idempotent
Tweak the footer a little bit.
parent
8480c6ee
Changes
1
Hide whitespace changes
Inline
Side-by-side
footer.lisp
View file @
016d6bae
...
...
@@ -4,44 +4,48 @@
(
uiop/package:define-package
:asdf/footer
(
:recycle
:asdf/footer
:asdf
)
(
:use
:uiop/common-lisp
:uiop
:asdf/upgrade
:asdf/find-system
:asdf/operate
:asdf/bundle
))
:asdf/upgrade
:asdf/find-system
:asdf/operate
:asdf/bundle
)
;; Happily, all those implementations all have the same module-provider hook interface.
#+
(
or
abcl
clasp
cmucl
clozure
ecl
mkcl
sbcl
)
(
:import-from
#+
abcl
:sys
#+
(
or
clasp
cmucl
ecl
)
:ext
#+
clozure
:ccl
#+
mkcl
:mk-ext
#+
sbcl
sb-ext
#:*module-provider-functions*
#+
(
or
clasp
ecl
mkcl
)
#:*load-hooks*
)
#+
mkcl
(
:import-from
:si
#:*load-hooks*
))
(
in-package
:asdf/footer
)
;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
#+
(
or
abcl
clasp
clisp
clozure
cmucl
ecl
mkcl
sbcl
)
(
with-upgradability
()
(
if-let
(
x
(
and
#+
clisp
(
find-symbol*
'
#:*module-provider-functions*
:custom
nil
)))
(
eval
`
(
pushnew
'module-provide-asdf
#+
abcl
sys::*module-provider-functions*
#+
(
or
clasp
cmucl
ecl
)
ext:*module-provider-functions*
#+
clisp
,
x
#+
clozure
ccl:*module-provider-functions*
#+
mkcl
mk-ext:*module-provider-functions*
#+
sbcl
sb-ext:*module-provider-functions*
)))
#-
clisp
(
pushnew
'module-provide-asdf
*module-provider-functions*
)
#+
clisp
(
if-let
(
x
(
and
#+
clisp
(
find-symbol*
'
#:*module-provider-functions*
:custom
nil
)))
(
eval
`
(
pushnew
'module-provide-asdf
,
x
)))
#+
(
or
clasp
ecl
mkcl
)
(
progn
(
pushnew
'
(
"fasb"
.
si::load-binary
)
si::*load-hooks*
:test
'equal
:key
'car
)
#+
(
or
(
and
clasp
windows
)
(
and
ecl
win32
)
(
and
mkcl
windows
))
(
unless
(
assoc
"asd"
#+
(
or
clasp
ecl
)
ext:*load-hooks*
#+
mkcl
si::*load-hooks*
:test
'equal
)
(
appendf
#+
(
or
clasp
ecl
)
ext:*load-hooks*
#+
mkcl
si::*load-hooks*
'
((
"asd"
.
si::load-source
))))
(
setf
#+
(
or
clasp
ecl
)
ext:*module-provider-functions*
#+
mkcl
mk-ext::*module-provider-functions*
(
loop
:for
f
:in
#+
(
or
clasp
ecl
)
ext:*module-provider-functions*
#+
mkcl
mk-ext::*module-provider-functions*
:collect
(
if
(
eq
f
'module-provide-asdf
)
f
#'
(
lambda
(
name
)
(
let
((
l
(
multiple-value-list
(
funcall
f
name
))))
(
and
(
first
l
)
(
register-preloaded-system
(
coerce-name
name
)))
(
values-list
l
))))))))
(
pushnew
'
(
"fasb"
.
si::load-binary
)
*load-hooks*
:test
'equal
:key
'car
)
#+
os-windows
(
unless
(
assoc
"asd"
*load-hooks*
:test
'equal
)
(
appendf
*load-hooks*
'
((
"asd"
.
si::load-source
))))
;; Wrap module provider functions in an idempotent, upgrade friendly way
(
defvar
*wrapped-module-provider*
(
make-hash-table
))
(
setf
(
gethash
'module-provide-asdf
*wrapped-module-provider*
)
'module-provide-asdf
)
(
defun
wrap-module-provider
(
provider
name
)
(
let
((
results
(
multiple-value-list
(
funcall
provider
name
))))
(
when
(
first
results
)
(
register-preloaded-system
(
coerce-name
name
)))
(
values-list
results
)))
(
setf
*module-provider-functions*
(
loop
:for
provider
:in
*module-provider-functions*
:collect
(
ensure-gethash
provider
*wrapped-module-provider*
#'
(
lambda
(
module-name
)
(
wrap-module-provider
provider
module-name
)))))))
#+
cmucl
;; Hook into the CMUCL herald.
(
with-upgradability
()
(
defun
herald-asdf
(
stream
)
(
format
stream
" ASDF ~A"
(
asdf-version
)))
(
setf
(
getf
ext:*herald-items*
:asdf
)
`
(
herald-asdf
)))
(
setf
(
getf
ext:*herald-items*
:asdf
)
'
(
herald-asdf
)))
;;;; Done!
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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