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
asdf
asdf
Commits
ba02b6a7
Commit
ba02b6a7
authored
Jan 13, 2013
by
Francois-Rene Rideau
Browse files
2.26.89: Be nicer with :read-file-form versions. Don't consider equal inherited symbols fishy.
Also settle on names for resume-image API.
parent
d862e5a9
Changes
8
Hide whitespace changes
Inline
Side-by-side
asdf.asd
View file @
ba02b6a7
...
...
@@ -15,7 +15,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.26.8
8
"
;; to be automatically updated by bin/bump-revision
:version
"2.26.8
9
"
;; to be automatically updated by bin/bump-revision
:depends-on
()
:components
((
:module
"build"
:components
((
:file
"asdf"
))))
:in-order-to
(
#+
asdf2.27
(
compile-op
(
monolithic-load-concatenated-source-op
generate-asdf
))))
...
...
defsystem.lisp
View file @
ba02b6a7
...
...
@@ -127,7 +127,7 @@
(
component-pathname
ret
)
; eagerly compute the absolute pathname
(
when
versionp
(
unless
(
parse-version
(
normalize-version
version
(
component-pathname
(
component-system
ret
)))
nil
)
version
(
system-source-directory
(
component-system
ret
)))
nil
)
(
warn
(
compatfmt
"~@<Invalid version ~S for component ~S~@[ of ~S~]~@:>"
)
version
name
parent
)))
(
when
(
typep
ret
'parent-component
)
...
...
header.lisp
View file @
ba02b6a7
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.8
8
: Another System Definition Facility.
;;; This is ASDF 2.26.8
9
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
image.lisp
View file @
ba02b6a7
...
...
@@ -13,7 +13,7 @@
#:register-image-resume-hook
#:register-image-dump-hook
#:call-image-resume-hook
#:call-image-dump-hook
#:initialize-asdf-utilities
#:resume-image
#:run-resumed-
program
#:dump-image
#:resume-image
#:run-resumed-
image
#:dump-image
))
(
in-package
:asdf/image
)
...
...
@@ -216,9 +216,9 @@ if we are not called from a directly executable image dumped by XCVB."
(
when
entry-point
(
apply
entry-point
*command-line-arguments*
)))
(
defun*
run-resumed-
program
()
(
defun*
run-resumed-
image
()
(
with-coded-exit
()
(
let
((
ret
(
resume-
program
)))
(
let
((
ret
(
resume-
image
)))
(
if
(
typep
ret
'integer
)
(
quit
ret
)
(
quit
99
)))))
...
...
@@ -253,26 +253,26 @@ if we are not called from a directly executable image dumped by XCVB."
(
list
:norc
t
:script
nil
:init-function
#'
resume
:init-function
#'
run-
resume
d-image
;; :parse-options nil ;--- requires a non-standard patch to clisp.
)))
#+
clozure
(
ccl:save-application
filename
:prepend-kernel
t
:toplevel-function
(
when
executable
#'
r
esum
e
))
:toplevel-function
(
when
executable
#'
r
un-resumed-imag
e
))
#+
(
or
cmu
scl
)
(
progn
(
ext:gc
:full
t
)
(
setf
ext:*batch-mode*
nil
)
(
setf
ext::*gc-run-time*
0
)
(
apply
'ext:save-lisp
filename
#+
cmu
:executable
#+
cmu
t
(
when
executable
'
(
:init-function
r
esum
e
:process-command-line
nil
))))
(
when
executable
'
(
:init-function
r
un-resumed-imag
e
:process-command-line
nil
))))
#+
gcl
(
progn
(
si::set-hole-size
500
)
(
si::gbc
nil
)
(
si::sgc-on
t
)
(
si::save-system
filename
))
#+
lispworks
(
if
executable
(
lispworks:deliver
'r
esum
e
filename
0
:interface
nil
)
(
lispworks:deliver
'r
un-resumed-imag
e
filename
0
:interface
nil
)
(
hcl:save-image
filename
:environment
nil
))
#+
sbcl
(
progn
...
...
@@ -280,7 +280,7 @@ if we are not called from a directly executable image dumped by XCVB."
(
setf
sb-ext::*gc-run-time*
0
)
(
apply
'sb-ext:save-lisp-and-die
filename
:executable
t
;--- always include the runtime that goes with the core
(
when
executable
(
list
:toplevel
#'
r
esum
e
:save-runtime-options
t
))))
;--- only save runtime-options for standalone executables
(
when
executable
(
list
:toplevel
#'
r
un-resumed-imag
e
:save-runtime-options
t
))))
;--- only save runtime-options for standalone executables
#-
(
or
allegro
clisp
clozure
cmu
gcl
lispworks
sbcl
scl
)
(
die
98
"Can't dump ~S: asdf doesn't support image dumping with this Lisp implementation.~%"
filename
))
...
...
lisp-build.lisp
View file @
ba02b6a7
...
...
@@ -119,7 +119,7 @@ a simple vector of length 2, arguments to find-symbol* with result as above,
or a string describing the format-control of a simple-condition."
(
etypecase
x
(
symbol
(
typep
condition
x
))
((
simple-vector
2
)
(
typep
condition
(
find-symbol*
(
svref
x
0
)
(
svref
x
1
)
nil
)))
((
simple-vector
2
)
(
typep
condition
(
unreify-symbol
x
)))
(
function
(
funcall
x
condition
))
(
string
(
and
(
typep
condition
'simple-condition
)
#+
(
or
allegro
clozure
cmu
scl
)
;; On SBCL, it's always set & the check warns
...
...
@@ -334,4 +334,3 @@ for processing later (possibly in a different process)."
(
scm:concatenate-system
output
:fasls-to-concatenate
))
(
loop
:for
f
:in
fasls
:do
(
ignore-errors
(
delete-file
f
)))
(
ignore-errors
(
lispworks:delete-system
:fasls-to-concatenate
)))))
package.lisp
View file @
ba02b6a7
...
...
@@ -16,6 +16,7 @@
#:find-package*
#:find-symbol*
#:symbol-call
#:intern*
#:unintern*
#:symbol-shadowing-p
#:rehome-symbol
#:delete-package*
#:package-names
#:packages-from-names
#:reify-symbol
#:unreify-symbol
#:package-definition-form
#:ensure-package
#:define-package
))
(
in-package
:asdf/package
)
...
...
@@ -64,18 +65,41 @@ or when loading the package is optional."
(
values
nil
nil
))))
(
defun
symbol-shadowing-p
(
symbol
package
)
(
and
(
member
symbol
(
package-shadowing-symbols
package
))
t
))
(
defun
home-package-p
(
symbol
package
)
(
eq
(
symbol-package
symbol
)
(
find-package*
package
))))
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
defun
symbol-package-name
(
symbol
)
(
let
((
package
(
symbol-package
symbol
)))
(
and
package
(
package-name
package
))))
(
defun
symbol-vector
(
symbol
)
(
vector
(
symbol-name
symbol
)
(
symbol-package-name
symbol
)))
(
defun
vector-symbol
(
vector
)
(
let*
((
symbol-name
(
aref
vector
0
))
(
package-name
(
aref
vector
1
)))
(
if
package-name
(
intern
symbol-name
package-name
)
(
make-symbol
symbol-name
))))
(
defun
home-package-p
(
symbol
package
)
(
eq
(
symbol-package
symbol
)
(
find-package*
package
))))
(
defun
standard-common-lisp-symbol-p
(
symbol
)
(
multiple-value-bind
(
sym
status
)
(
find-symbol*
symbol
:common-lisp
nil
)
(
and
(
eq
sym
symbol
)
(
eq
status
:external
))))
(
defun
reify-package
(
package
&optional
package-context
)
(
if
(
eq
package
package-context
)
t
(
etypecase
package
(
null
nil
)
((
eql
(
find-package
:cl
))
:cl
)
(
package
(
package-name
package
)))))
(
defun
unreify-package
(
package
&optional
package-context
)
(
etypecase
package
(
null
nil
)
((
eql
t
)
package-context
)
((
or
symbol
string
)
(
find-package
package
))))
(
defun
reify-symbol
(
symbol
&optional
package-context
)
(
etypecase
symbol
((
or
keyword
(
satisfies
standard-common-lisp-symbol-p
))
symbol
)
(
symbol
(
vector
(
symbol-name
symbol
)
(
reify-package
(
symbol-package
symbol
)
package-context
)))))
(
defun
unreify-symbol
(
symbol
&optional
package-context
)
(
etypecase
symbol
(
symbol
symbol
)
((
simple-vector
2
)
(
let*
((
symbol-name
(
svref
symbol
0
))
(
package-foo
(
svref
symbol
1
))
(
package
(
unreify-package
package-foo
package-context
)))
(
if
package
(
intern
symbol-name
package
)
(
make-symbol
symbol-name
)))))))
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
#+
(
or
clisp
clozure
)
...
...
@@ -260,37 +284,45 @@ or when loading the package is optional."
;;; ensure-package, define-package
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
defvar
*fishy-package-changes*
'
(
t
))
(
defun
ensure-package
(
name
&key
(
fishyp
*fishy-package-changes*
)
nicknames
documentation
use
shadow
shadowing-import-from
import-from
export
intern
recycle
mix
reexport
unintern
)
(
let*
((
name
(
string
name
))
(
nicknames
(
mapcar
#'
string
nicknames
))
(
names
(
cons
name
nicknames
))
(
previous
(
packages-from-names
names
))
(
discarded
(
cdr
previous
))
(
to-delete
())
(
package
(
or
(
first
previous
)
(
make-package
name
:nicknames
nicknames
)))
(
recycle
(
packages-from-names
recycle
))
(
use
(
mapcar
'find-package*
use
))
(
mix
(
mapcar
'find-package*
mix
))
(
reexport
(
mapcar
'find-package*
reexport
))
(
shadow
(
mapcar
'string
shadow
))
(
export
(
mapcar
'string
export
))
(
intern
(
mapcar
'string
intern
))
(
unintern
(
mapcar
'string
unintern
))
(
shadowed
(
make-hash-table
:test
'equal
))
; string to bool
(
imported
(
make-hash-table
:test
'equal
))
; string to bool
(
exported
(
make-hash-table
:test
'equal
))
; string to bool
;; string to list canonical package and providing package:
(
inherited
(
make-hash-table
:test
'equal
))
(
fishy
()))
; fishy stuff we did
(
macrolet
((
fishy
(
&rest
info
)
`
(
when
fishyp
(
push
(
list
,@
info
)
fishy
))))
(
defvar
*record-fishy-package-changes*
'
(
t
))
(
defvar
*fishy-package-changes*
'
())
(
defun
flush-fishy
()
(
when
*fishy-package-changes*
(
push
(
nreverse
*fishy-package-changes*
)
*record-fishy-package-changes*
)
(
setf
*fishy-package-changes*
nil
)))
(
defun
record-fishy
(
info
)
(
push
info
*fishy-package-changes*
))
(
macrolet
((
when-fishy
(
&body
body
)
`
(
when
*record-fishy-package-changes*
,@
body
))
(
fishy
(
&rest
info
)
`
(
when-fishy
(
record-fishy
(
list
,@
info
)))))
(
defun
ensure-package
(
name
&key
nicknames
documentation
use
shadow
shadowing-import-from
import-from
export
intern
recycle
mix
reexport
unintern
)
(
let*
((
name
(
string
name
))
(
nicknames
(
mapcar
#'
string
nicknames
))
(
names
(
cons
name
nicknames
))
(
previous
(
packages-from-names
names
))
(
discarded
(
cdr
previous
))
(
to-delete
())
(
package
(
or
(
first
previous
)
(
make-package
name
:nicknames
nicknames
)))
(
recycle
(
packages-from-names
recycle
))
(
use
(
mapcar
'find-package*
use
))
(
mix
(
mapcar
'find-package*
mix
))
(
reexport
(
mapcar
'find-package*
reexport
))
(
shadow
(
mapcar
'string
shadow
))
(
export
(
mapcar
'string
export
))
(
intern
(
mapcar
'string
intern
))
(
unintern
(
mapcar
'string
unintern
))
(
shadowed
(
make-hash-table
:test
'equal
))
; string to bool
(
imported
(
make-hash-table
:test
'equal
))
; string to bool
(
exported
(
make-hash-table
:test
'equal
))
; string to bool
;; string to list home package and use package:
(
inherited
(
make-hash-table
:test
'equal
)))
(
when-fishy
(
record-fishy
name
))
(
labels
((
ensure-shadowing-import
(
name
p
)
(
let
((
import
(
find-symbol*
name
p
)))
...
...
@@ -367,7 +399,7 @@ or when loading the package is optional."
name
(
package-name
sp
)
(
package-name
xp
))))
(
t
(
setf
(
gethash
name
inherited
)
(
list
sp
p
))
(
when
status
(
when
(
and
status
(
not
(
eq
sp
xp
)))
(
let
((
shadowing
(
symbol-shadowing-p
existing
package
)))
(
fishy
:inherited
name
(
package-name
p
)
(
package-name
sp
)
(
package-name
xp
))
...
...
@@ -436,10 +468,9 @@ or when loading the package is optional."
:for
n
=
(
remove-if
#'
(
lambda
(
x
)
(
member
x
names
:test
'equal
))
(
package-names
p
))
:do
(
fishy
:nickname
(
package-names
p
))
(
if
n
(
rename-package
p
(
first
n
)
(
rest
n
))
(
progn
(
rename-package-away
p
)
(
push
p
to-delete
))))
(
cond
(
n
(
rename-package
p
(
first
n
)
(
rest
n
)))
(
t
(
rename-package-away
p
)
(
push
p
to-delete
))))
(
rename-package
package
name
nicknames
)
(
dolist
(
name
unintern
)
(
multiple-value-bind
(
existing
status
)
(
find-symbol
name
package
)
...
...
@@ -494,7 +525,7 @@ or when loading the package is optional."
(
do-symbols
(
sym
package
)
(
ensure-symbol
(
symbol-name
sym
)))
(
map
()
'delete-package*
to-delete
)
(
when
fishy
(
push
(
cons
name
fishy
)
*fishy-package-changes*
)
)
(
flush-fishy
)
package
)))))
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
...
...
upgrade.lisp
View file @
ba02b6a7
...
...
@@ -32,7 +32,7 @@
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(
asdf-version
"2.26.8
8
"
)
(
asdf-version
"2.26.8
9
"
)
(
existing-asdf
(
find-class
(
find-symbol*
:component
:asdf
nil
)
nil
))
(
existing-version
*asdf-version*
)
(
already-there
(
equal
asdf-version
existing-version
)))
...
...
version.lisp-expr
View file @
ba02b6a7
"2.26.8
8
"
"2.26.8
9
"
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