Commit c58257d9 authored by Daniel Barlow's avatar Daniel Barlow
Browse files

Initial revision

parents
asdf: another system definition facility -*- Text -*-
[ Changes in draft 3: plans go away again, but process-option comes
in. OPERATION turns into a clos object ]
[ Changes in draft 2: acknowledge sources, incorporated bunch of stuff
from kmp proposal, perhaps-easier-to-understand version-satisfies
sample implementation ]
This system definition utility talks in terms of 'components' and
'operations'.
Components form systems: a component represents a source file, or a
collection of source files. A system is therefore a component,
recursively formed of a tree of subcomponents.
Operations are instantiated then performed on the nodes of a tree to
do things like
- compile all its files
- load the files into a running lisp environment
- copy its source files somewhere else
Operations can be invoked directly, or examined to see what their
effects would be without performing them. There are a bunch of
methods specialised on operation and component type which actually do
the grunt work.
asdf is extensible to new operations and to new component types. This
allows the addition of behaviours: for example, a new component could
be added for Java JAR archives, and methods specialised on
compile-system added for it that would accomplish the relevant
actions.
asdf is not presently extensible to new syntax (for example, to
emulate other defsystem utilities), but that's on the cards for a
future version.
* Inspiration
** mk-defsystem (defsystem-3.x)
We aim to solve basically the same problems as mk-defsystem does.
However, our architecture for extensibility better exploits CL
language features (and is documented), and we intend to be portable
rather than just widely-ported. No slight on the mk-defsystem authors
and maintainers is intended here; that implementation has the
unenviable task of supporting non-ANSI implementations, which I
propose to ignore.
The surface defsystem syntax of asdf is more-or-less compatible with
mk-defsystem
The mk-defsystem code for topologically sorting a module's dependency
list was very useful.
** defsystem-4 proposal
Marco and Peter's proposal for defsystem 4 served as the driver for
many of the features in here, Notable differences are
- we don't specify output files or output file extensions as part of
the system
If you want to find out what files an operation would create, ask
the operation
- we don't deal with CL packages
If you want to compile in a particular package, use an in-package
form in that file (ilisp will like you more if you do this anyway)
- there is no proposal here that defsystem does version control.
A system has a given version which can be used to check
dependencies, but that's all.
The defsystem 4 proposal tends to look more at the external features,
whereas this one centres on a protocol for system introspection.
** kmp's "The Description of Large Systems", MIT AI Memu 801
Available in updated-for-CL form on the web at
http://world.std.com/~pitman/Papers/Large-Systems.html
In our implementation we borrow kmp's overall PROCESS-OPTIONS and
PROCESS-OPTION concepts to deal with creating component trees from
defsystem surface syntax. We haven't yet decided whether or how to
present this to users (i.e to specify it) but that will probably
happen one way or another.
* component
** a component has:
*** A name (required)
This is a string. It must satisfy the restrictions imposed on a
portable pathname character.
*** a version identifier (optional, will default to parent's version)
This is used by the check-component-version operation (see later).
*** dependencies on its siblings (optional but often necessary)
This slot contains a list whose elements are each names of siblings,
or lists of (name version) for siblings
[ this will change. Dependencies are between (component operation)
pairs, not between components themselves ]
*** a filesystem location
Optional, may be inferred from name, type (the subclass of
source-file), and location of parent.
Note that a component doesn't actually have any references to its
parent, so this inference will only be valid in the context of a
system operation (a special variable is bound to the location of
the parent while a child is processed)
** components are subclassed into
*** 'source-file'
A source file is any file that the system does not know how to
generate from other components of the system.
(Note that this is not quite the same thing as "a file containing data
that is typically fed to a compiler". If a file is generated by some
pre-processor stage (e.g. a ".h" file from ".h.in" by autoconf) then
it is not, by this definition, a source file. Conversely, we might
have a graphic file that cannot be automatically regenerated, or a
proprietary shared library that we received as a binary: these do
count as source files for our purposes. All suggestions for better
terminology gratefully received)
Subclasses of source-file exist for various languages.
*** 'module', a collection of sub-components
This has extra slots :components and :default-component-class.
Most operations will not need to provide methods specialised on
modules, as the tree traversal happens automatically,
A system object is usually a module.
The module may be subclassed to represent components such as
foreign-language linked libraries or archive files.
* operation
An operation is instantiated whenever the user asks that an operation
be performed, inspected, or etc. The operation object contains
whatever state is relevant to this purpose (perhaps a list of visited
nodes, for example) but primarily is a nicer thing to specialise
operation methods on than having them all be EQL methods.
There are no differences between standard operations and user-defined
operations, except that the user is respectfully requested to keep his
(or more importantly, our) package namespace clean
** invoking operations
(oos operation system &rest keywords-args)
keyword-args are passed to the make-instance call when creating the
operation: valid keywords depend on the initargs that the operation is
defined to accept.
** standard operations
*** compile-system &key proclamations
The definition of `compile' is "do everything that we can do to make
subsequent loads (in a new image that we didn't do the compile in)"
faster.
If proclamations are supplied, they will be proclaimed. This is a
good place to specify optimization settings
*** load-system
This is the `do everything' operation. It depends on compile-system.
*** test-system-version &key minimum
Asks the system whether it satisfies a version requirement.
The default method accepts a string, which is expected to contain of a
number of integers separated by #\. characters. The method is not
recursive. The component satisfies the version dependency if it has
the same major number as required and each of its sub-versions is
greater than or equal to the sub-version number required.
(defun version-satisfies (x y)
(labels ((bigger (x y)
(cond ((not y) t)
((not x) nil)
((> (car x) (car y)) t)
((= (car x) (car y))
(bigger (cdr x) (cdr y))))))
(and (= (car x) (car y))
(or (not (cdr y)) (bigger (cdr x) (cdr y))))))
If that doesn't work for your system, you can override it. I hope
yoyu have as much fun writing the new method as #lisp did
reimplementing this one.
** Creating new operations
subclass operation, provide methods for source-file for
- perform
- explain
- output-files
- operation-done-p, if you don't like the default one
* System definitions
** Finding them
(find-system name) => a MODULE object
Systems are named by strings. If a system is not present in memory
when asked for, attempts are made to load a file which is expected to
define it. This file has the name of the system, the type "system",
and is looked for in each of the directories given by evaluating
members of *central-registry*
A system may also be referred to by symbol. In this case the symbol
name is taken before a lookup is performed.
When system definitions are loaded from .system files, a new scratch
package is created for them to load into, so that different systems
do not overwrite each others operations. The user may also wish
to include defpackage and in-package forms in his system definiton
files, however, so that they can be loaded manually if need be.
** Syntax
There is a defsystem form which looks basically similar to
mk-defsystem syntax
We extend the defsystem syntax to allow for eql-specialised methods on
modules -
(:module "foo" (:components "bar" "baz" "quux")
(:perform compile-system :after ((c component))
(do-something c))
(:explain compile-system :after ((c component))
(explain-something c))
has the effect of
(defmethod perform :after ((operation (eql 'compile-system)) ((c component)))
(do-something c))
(defmethod explain :after ((operation (eql 'compile-system)) ((c component)))
(explain-something c))
** shorthand for source-file components
source-file components defined with (:file "a-string") or "a-string"
will have the string parsed into name and type as if it were a
filename, and an instance of the appropriate source-file subclass
created. If a type is not provided, it will default to the parent's
default component type.
* Error handling
It is an error to define a system incorrectly: an implementation may
detect this and signal a SYSTEM-DEFINITION-ERROR or generalised
instance thereof
Operations may go wrong (for example when source files contain
errors). These are signalled using generalised instances of
OPERATION-ERROR
----------------------------------------------------------
TODO List
----------------------------------------------------------
* Outstanding spec questions, things to add
** Finding code: ":source-pathname " is not really good enough unless
LPNs suddenly develop union filesystem semantics
** case-sensitivity wrt filenames
Convention is to refer to systems with symbols, which means they end
up being named by uppercase strings. To find a .system file we
(make-pathname :name name :type "SYSTEM" :case :common) ("use the file
system's customary case") which translates this uppercase into
whatever case is nicest (lowercase for sbcl on unix)
For merging component names we use whatever the user supplied -
probably lowercase - and lowercase extensions, with :case :local.
This appears to work out fine, but but I haven't thought too hard
about it
** defsystem syntax
*** export process-option-list?
*** shortcut to setting up dependencies using :serial, :parallel
options.
*** split into native syntax and mixin for mk- syntax extras
** Argh dependencies.
Our dependencies are conceptually wrong. Dependencies exist between
the application of operations to components, not the components
themselves. For example, there is an implied dependency in
mk-defsystem
for all x, (load x) depends on (compile x)
and specifying that b depends on a _actually_ means that
(compile b) depends on (load a)
We should do this the more general way internally even if it never
gets to surface syntax; it'd make the whole "compile-after-load"
stuff a lot cleaner.
* missing bits in implementation
** all of the above
** package exports
present list is ad-hoc, so go through and consider it properly
** reuse the same scratch package whenever a system is reloaded from disk
** defsystem syntax for EQL methods
** dependency circularities: test it works
** versions
;;; the problem with writing a defsystem replacement is bootstrapping:
;;; we can't use defsystem to compile it. Hence, all in one file
(defpackage #:asdf
(:export #:defsystem #:oos #:find-system #:run-shell-command
#:unix-dso #:compile-system #:load-system #:component-pathname
#:module-components #:output-files
#:component #:module #:source-file #:operation
#:c-source-file #:cl-source-file
#:component-pathname #:perform
#:*component-parent-pathname*
#:operation-error #:system-definition-error #:system-not-found
#:circular-dependency
#:compile-failed #:compile-warned
))
(in-package #:asdf)
(proclaim '(optimize (debug 3)))
(declaim (optimize (debug 3)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; problems
(define-condition system-definition-error (error)
())
(define-condition circular-dependency (system-definition-error)
((components :initarg :components)))
(define-condition system-not-found (system-definition-error)
((name :initform "(unnamed)" :reader system-name :initarg :name))
(:report (lambda (c s)
(format s "System ~S not found"
(system-name c)))))
(define-condition operation-error (error)
((component :reader error-component :initarg :component)
(operation :reader error-operation :initarg :operation))
(:report (lambda (c s)
(format s "Erred while invoking ~A on ~A"
(error-operation c) (error-component c)))))
(define-condition compile-failed (operation-error) ())
(define-condition compile-warned (operation-error) ())
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; components
(defclass component ()
((name :type string :accessor component-name :initarg :name :documentation
"Component name, restricted to portable pathname characters")
(version :accessor component-version :initarg :version)
(depends-on :initform nil
:accessor component-depends-on :initarg :depends-on)
;; no direct accessor for pathname, we do this as a method to allow
;; it to default in funky ways if not supplied
;; :pathname is actually a realy bad choice of name for this slot,
;; because quite often that's not what we actually use it for
(pathname :initarg :pathname)))
(defmethod component-pathname ((component component))
(let ((*default-pathname-defaults* *component-parent-pathname*))
(if (slot-boundp component 'pathname)
(let ((p (slot-value component 'pathname)))
(cond ((pathnamep p)
(merge-pathnames p))
((and (stringp p) (> (length p) 0))
(destructuring-bind (name type) (split p 2 '(#\.))
(merge-pathnames (make-pathname :name name :type type))))
((and (stringp p) (= (length p) 0))
*component-parent-pathname*)
(t
(warn ":pathname argument to ~A is not a pathname designator. Ignoring it" component)
(merge-pathnames (component-relative-pathname component)))))
(merge-pathnames (component-relative-pathname component)))))
(defmethod print-object ((c component) stream)
(print-unreadable-object (c stream :type t :identity t)
(ignore-errors
(prin1 (component-name c) stream))))
(defclass module (component)
((components :accessor module-components :initarg :components)
(default-component-class :accessor module-default-component-class
:initform 'cl-source-file :initarg :default-component-class)))
(defmethod component-relative-pathname ((component module))
(make-pathname :directory `(:relative ,(component-name component))
:host (pathname-host *component-parent-pathname*)))
(defmethod find-component ((module module) name)
(if (slot-boundp module 'components)
(find name (module-components module)
:test #'equal :key #'component-name)))
;;; a component with no parent is a system
(defmethod find-component ((module (eql nil)) name)
(find-system name))
(defclass source-file (component) ())
(defclass cl-source-file (source-file) ())
;;; a reversible registry that lets us query class <-> extension
(defvar *known-extensions*
'(("lisp" . cl-source-file)
("c" . c-source-file)
("java" . java-source-file)))
(defmethod component-relative-pathname ((component source-file))
(make-pathname :name (component-name component)
:type (car (rassoc (class-name (class-of component))
*known-extensions* ))))
(defclass c-source-file (source-file) ())
(defclass java-source-file (source-file) ())
;;; XXX we don't need the first of these if we have the second
(defvar *component-parent-pathname*)
(defvar *component-parent*)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; operations
;;; one of these is instantiated whenever (operate ) is called
(defclass operation ()
((forced-p :initform nil :initarg :force :accessor operation-forced-p )
(visited-components :initform nil :accessor operation-visited-components)
(visiting-components :initform nil :accessor operation-visiting-components)))
(defgeneric perform (operation system))
(defgeneric operation-done-p (operation system))
(defgeneric explain (operation system))
(defgeneric output-files (operation system))
(defmethod visit-component ((o operation) (c component))
(pushnew c (operation-visited-components o)))
(defmethod component-visited-p ((o operation) (c component))
(member c (operation-visited-components o)))
(defmethod (setf visiting-component) (new-value (o operation) (c component))
(if new-value
(pushnew c (operation-visiting-components o))
(setf (operation-visiting-components o)
(remove c (operation-visiting-components o)))))
(defmethod component-visiting-p ((o operation) (c component))
(member c (operation-visiting-components o)))
;;; this needs a new name. should be operation-needs-doing-p
(defmethod operation-done-p ((o operation) (c source-file))
(let ((binaries (output-files o c))
(source-write-date
(and (probe-file (component-pathname c))
(file-write-date (component-pathname c)))))
(and source-write-date binaries
(every (lambda (b)
(and (probe-file b)
(> (file-write-date b) source-write-date)))
binaries))))
(defmethod operation-done-p ((o operation) (c component))
;;; can't tell easily
nil)
;;; So you look at this code and think "why isn't it a bunch of
;;; methods". And the answer is, because standard method combination
;;; runs :before methods most->least-specific, which is back to front
;;; for our purposes. And CLISP apparently doesn't have non-standard
;;; method combinations, so let's keep it simple and aspire to
;;; portability
(defmethod traverse ((operation operation) (c component) function)
; dependencies
(if (and nil (component-visiting-p operation c))
(error 'circular-dependency :components (list c)))
(setf (visiting-component operation c) t)
(mapc (lambda (k)
(traverse operation (find-component *component-parent* k)
function))
(component-depends-on c))
;; constituent bits
(when (typep c 'module)
(let ((*component-parent-pathname*
(component-pathname c))
(*component-parent* c))
(mapc (lambda (c) (traverse operation c function))
(module-components c))))
;; now the thing itself
(unless (component-visited-p operation c)
(if (or (operation-forced-p operation)
(not (operation-done-p operation c)))
(loop
(restart-case
(progn (funcall function operation c)
(return))
(retry-component ())
(skip-component () (return)))))
(setf (visiting-component operation c) nil)
(visit-component operation c)))
(defmethod perform ((operation operation) (c source-file))
(error
"Required method PERFORM not implemented for operation ~A, component ~A"
(class-of operation) (class-of c)))
(defmethod perform ((operation operation) (c module))
nil)
(defmethod explain ((operation operation) (component component))
(format *trace-output* "~&;;; ~A on ~A~%"
operation component))
(defmethod output-files ((operation operation) (c component))
(error "Required method OUTPUT-FILES not implemented for operation ~A"
(class-of operation)))
;;; compile-system
(defclass compile-system (operation)
((proclamations :initarg :proclamations :accessor compile-system-proclamations :initform nil)
(fail-on-error-p :initarg :fail-on-error
:accessor operation-fail-on-error-p :initform t)
(fail-on-warning-p :initarg :fail-on-warning
:accessor operation-fail-on-warning-p :initform nil)))
(defmethod perform ((operation compile-system) (c cl-source-file))
(let ((source-file (component-pathname c)))
(multiple-value-bind (output warnings-p failure-p)
(compile-file source-file)
(when (and warnings-p (operation-fail-on-warning-p operation))
(error 'compile-warned :component c :operation operation))
(when (and failure-p (operation-fail-on-error-p operation))
(error 'compile-failed :component c :operation operation))
;; now load the file. this is a hack which will go away when we
;; work out dependencies properly
(load output))))
(defmethod output-files ((operation compile-system) (c cl-source-file))
(list (compile-file-pathname (component-pathname c))))
;;; load-system
(defclass load-system (operation) ())
(defmethod perform ((o load-system) (c cl-source-file))
(let ((co (make-instance 'compile-system)))
(load (car (output-files co c)))))
(defmethod output-files ((operation load-system) (c component))
nil)
;;; test-system-version
(defclass test-system-version (operation)
((minimum :initarg :minimum :initform ""
:accessor test-system-version-minimum)))
;;; you may have seen this before ...
(defun split (string &optional max (ws '(#\Space #\Tab)))
(flet ((is-ws (char) (find char ws)))
(nreverse
(let ((list nil) (start 0) (words 0) end)
(loop
(when (and max (>= words (1- max)))
(return (cons (subseq string start) list)))
(setf end (position-if #'is-ws string :start start))
(push (subseq string start end) list)
(incf words)
(unless end (return list))
(setf start (1+ end)))))))
(defmethod perform ((operation test-system-version) (c component))
(let ((x (mapcar #'parse-integer
(split (component-version c) nil '(#\.))))
(y (mapcar #'parse-integer
(split
(test-system-version-minimum operation) nil '(#\.)))))
(labels ((bigger (x y)
(cond ((not y) t)
((not x) nil)
((> (car x) (car y)) t)
((= (car x) (car y))
(bigger (cdr x) (cdr y))))))
(and (= (car x) (car y))
(or (not (cdr y)) (bigger (cdr x) (cdr y)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; invoking operations