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
Container registry
Model registry
Operate
Environments
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
Pascal J. Bourguignon
asdf
Commits
b55c5440
Commit
b55c5440
authored
22 years ago
by
Daniel Barlow
Browse files
Options
Downloads
Patches
Plain Diff
Patches from Brian Seitz ("Another load patch") and David Lichteblau
("asdf:defsystem class bug")
parent
dd2b8fe4
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
asdf.lisp
+19
-12
19 additions, 12 deletions
asdf.lisp
with
19 additions
and
12 deletions
asdf.lisp
+
19
−
12
View file @
b55c5440
...
@@ -315,12 +315,16 @@ system."))
...
@@ -315,12 +315,16 @@ system."))
(
defclass
cl-source-file
(
source-file
)
())
(
defclass
cl-source-file
(
source-file
)
())
(
defclass
c-source-file
(
source-file
)
())
(
defclass
c-source-file
(
source-file
)
())
(
defclass
java-source-file
(
source-file
)
())
(
defclass
java-source-file
(
source-file
)
())
(
defclass
static-file
(
source-file
)
())
(
defclass
doc-file
(
static-file
)
())
(
defclass
html-file
(
doc-file
)
())
(
defgeneric
source-file-type
(
component
system
))
(
defgeneric
source-file-type
(
component
system
))
(
defmethod
source-file-type
((
c
cl-source-file
)
(
s
module
))
"lisp"
)
(
defmethod
source-file-type
((
c
cl-source-file
)
(
s
module
))
"lisp"
)
(
defmethod
source-file-type
((
c
c-source-file
)
(
s
module
))
"c"
)
(
defmethod
source-file-type
((
c
c-source-file
)
(
s
module
))
"c"
)
(
defmethod
source-file-type
((
c
java-source-file
)
(
s
module
))
"java"
)
(
defmethod
source-file-type
((
c
java-source-file
)
(
s
module
))
"java"
)
(
defmethod
source-file-type
((
c
static-file
)
(
s
module
))
nil
)
(
defmethod
component-relative-pathname
((
component
source-file
))
(
defmethod
component-relative-pathname
((
component
source-file
))
(
let
((
*default-pathname-defaults*
(
component-parent-pathname
component
)))
(
let
((
*default-pathname-defaults*
(
component-parent-pathname
component
)))
(
or
(
slot-value
component
'relative-pathname
)
(
or
(
slot-value
component
'relative-pathname
)
...
@@ -329,10 +333,6 @@ system."))
...
@@ -329,10 +333,6 @@ system."))
(
source-file-type
component
(
source-file-type
component
(
component-system
component
))))))
(
component-system
component
))))))
(
defclass
static-file
(
source-file
)
())
(
defclass
doc-file
(
static-file
)
())
(
defclass
html-file
(
doc-file
)
())
(
defmethod
source-file-type
((
c
static-file
)
(
s
module
))
nil
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; operations
;;; operations
...
@@ -537,6 +537,7 @@ system."))
...
@@ -537,6 +537,7 @@ system."))
(
defmethod
perform
((
operation
compile-op
)
(
c
cl-source-file
))
(
defmethod
perform
((
operation
compile-op
)
(
c
cl-source-file
))
(
let
((
source-file
(
component-pathname
c
))
(
let
((
source-file
(
component-pathname
c
))
(
output-file
(
car
(
output-files
operation
c
))))
(
output-file
(
car
(
output-files
operation
c
))))
(
setf
(
component-property
c
'last-compiled
)
nil
)
(
multiple-value-bind
(
output
warnings-p
failure-p
)
(
multiple-value-bind
(
output
warnings-p
failure-p
)
(
compile-file
source-file
(
compile-file
source-file
:output-file
output-file
)
:output-file
output-file
)
...
@@ -571,8 +572,11 @@ system."))
...
@@ -571,8 +572,11 @@ system."))
(
defmethod
perform
((
o
load-op
)
(
c
cl-source-file
))
(
defmethod
perform
((
o
load-op
)
(
c
cl-source-file
))
(
let*
((
co
(
make-sub-operation
o
'compile-op
))
(
let*
((
co
(
make-sub-operation
o
'compile-op
))
(
output-files
(
output-files
co
c
)))
(
output-files
(
output-files
co
c
)))
(
setf
(
component-property
c
'last-loaded
)
(
file-write-date
(
car
output-files
)))
(
setf
(
component-property
c
'last-loaded
)
(
map
nil
#'
load
output-files
)))
(
if
(
some
#'
not
(
map
'list
#'
load
output-files
))
nil
(
file-write-date
(
car
output-files
))))))
(
defmethod
perform
((
operation
load-op
)
(
c
static-file
))
(
defmethod
perform
((
operation
load-op
)
(
c
static-file
))
nil
)
nil
)
...
@@ -591,7 +595,8 @@ system."))
...
@@ -591,7 +595,8 @@ system."))
(
defmethod
operation-done-p
((
o
load-op
)
(
c
source-file
))
(
defmethod
operation-done-p
((
o
load-op
)
(
c
source-file
))
(
if
(
or
(
not
(
component-property
c
'last-loaded
))
(
if
(
or
(
not
(
component-property
c
'last-loaded
))
(
>
(
or
(
component-property
c
'last-compiled
)
0
)
(
not
(
component-property
c
'last-compiled
))
(
>
(
component-property
c
'last-compiled
)
(
component-property
c
'last-loaded
)))
(
component-property
c
'last-loaded
)))
nil
t
))
nil
t
))
...
@@ -613,12 +618,14 @@ system."))
...
@@ -613,12 +618,14 @@ system."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; syntax
;;; syntax
(
defun
remove-keyword
(
key
arglist
)
(
loop
for
sublist
=
arglist
then
rest
until
(
null
sublist
)
for
(
elt
arg
.
rest
)
=
sublist
unless
(
eq
key
elt
)
append
(
list
elt
arg
)))
(
defmacro
defsystem
(
name
&body
options
)
(
defmacro
defsystem
(
name
&body
options
)
(
destructuring-bind
(
&key
pathname
(
class
'system
)
&allow-other-keys
)
options
(
destructuring-bind
(
&key
pathname
(
class
'system
)
&allow-other-keys
)
options
(
let
((
component-options
(
let
((
component-options
(
remove-keyword
:class
options
)))
(
if
(
member
:class
options
)
(
remove
:class
options
)
options
)))
`
(
progn
`
(
progn
;; system must be registered before we parse the body, otherwise
;; system must be registered before we parse the body, otherwise
;; we recur when trying to find an existing system of the same name
;; we recur when trying to find an existing system of the same 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