Commit aea4917b authored by Eric Timmons's avatar Eric Timmons Committed by Robert Goldman
Browse files

Add extension points for component parsing.

Eric Timmons writes [edited for compression]:

I decided to make a system class that infers components instead of systems called [asdf-inferred-components](https://gitlab.common-lisp.net/etimmons/asdf-inferred-components).

I found myself wanting a couple more points to intercede in the parsing of systems. This merge adds them.

At the moment they are not exported from the ASDF package, but we anticipate they will be exported after using them in practice for a while.

`class-for-type` is now a generic function that allows a custom `parent-component` class to control the mapping of component types (`:file`, `:module`, etc.) to classes.

I also turned `compute-component-children` into a GF (no backward compatibility issues there since the `defun` version of it has yet to be released) and moved a bit of the work it did back into `parse-component-form`.
parent 7c9714d3
......@@ -17,6 +17,8 @@ cl-asdf (2:3.3.5-1) unstable; urgency=low IN PROGRESS
Rideau, and Eric Schulte.
* Fix for argument handling in LAUNCH-PROGRAM.
* Fixes for feature handling from Eric Timmons.
* Replaced some of the internals of `parse-defsystem` with generic functions to
enable modular extension. Thanks to Eric Timmons.
cl-asdf (2:3.3.4-1) unstable; urgency=low
Bug fix release:
......
......@@ -147,6 +147,7 @@ The Object model of ASDF
* Components::
* Dependencies::
* Functions::
* Parsing system definitions::
Operations
......@@ -2261,6 +2262,7 @@ customize the behaviour of existing @emph{functions}.
* Components::
* Dependencies::
* Functions::
* Parsing system definitions::
@end menu
@node Operations, Components, The object model of ASDF, The object model of ASDF
......@@ -3352,7 +3354,7 @@ remain at the system level, and are not propagated along the hierarchy,
but instead do something global on the system.
@node Functions, , Dependencies, The object model of ASDF
@node Functions, Parsing system definitions, Dependencies, The object model of ASDF
@comment node-name, next, previous, up
@section Functions
......@@ -3388,6 +3390,62 @@ could be in the future extended to specify an exclusive upper bound for compatib
as well as an inclusive lower bound.
@end defun
@node Parsing system definitions, , Functions, The object model of ASDF
@section Parsing system definitions
@cindex Parsing system definitions
@cindex Extending ASDF's defsystem parser
Thanks to Eric Timmons, ASDF now provides hooks to extend how it parses
@code{defsystem} forms.
@strong{Warning!} These interfaces are experimental, and as such are not
exported from the ASDF package yet. We plan to export them in ASDF
3.4.0. If you use them before they are exported, please subscribe to
@url{https://gitlab.common-lisp.net/asdf/asdf/-/issues/76} so you are
made aware of any changes.
@defun parse-component-form @var{parent} @var{options} &key @var{previous-serial-components}
This is the core function for parsing a system definition. At the
moment, we do not expect ASDF extenders to modify this function.
When being called on a @code{component} of type @code{system} (i.e.,
inside the @code{defsystem} macro), @var{parent} will be @code{NIL}.
@end defun
@deffn {Generic function} compute-component-children @var{component} @var{components} @var{serial-p}
This generic function provides standard means for computing component
children, but can be extended with additional methods by a programmer.
Returns a list of children (of type @code{component}) for @var{component}.
@var{components} is a list of the explicitly defined children descriptions.
@var{serial-p} is non-@code{NIL} if each child in @var{components} should depend on the previous
children.
@end deffn
@deffn {Generic function} class-for-type @var{parent} @var{type-designator}
Return a @code{class} designator to be used to instantiate a component
whose type is specified by @var{type-designator} in the context of
@var{parent}, which should be either a @code{parent-component} -- or subclass
thereof -- or @code{nil} (if the type designator is some class of system).
This generic function provides a means for changing how ASDF translates
type-designators (like @code{:file}) into CLOS classes. It is intended
for programmers to extend by adding new methods.
@strong{Warning!} Adding new methods for @code{class-for-type} is
typically @emph{not} necessary: much can already be done by using
@code{:default-component-class} and defining (and explicitly calling
for) new component types.
@end deffn
@node Controlling where ASDF searches for systems, Controlling where ASDF saves compiled files, The object model of ASDF, Top
@comment node-name, next, previous, up
@chapter Controlling where ASDF searches for systems
......
......@@ -138,10 +138,7 @@ otherwise return a default system name computed from PACKAGE-NAME."
(when (typep top 'package-inferred-system)
(if-let (dir (component-pathname top))
(let* ((sub (subseq system-name (1+ (length primary))))
(component-type (class-for-type
nil
(or (module-default-component-class top)
*default-component-class*)))
(component-type (class-for-type top :file))
(file-type (file-type (make-instance component-type)))
(f (probe-file* (subpathname dir sub :type file-type)
:truename *resolve-symlinks*)))
......
......@@ -14,13 +14,16 @@
(:import-from :asdf/find-system #:define-op)
(:export
#:defsystem #:register-system-definition
#:class-for-type #:*default-component-class*
#:*default-component-class*
#:determine-system-directory #:parse-component-form
#:non-toplevel-system #:non-system-system #:bad-system-name
#:*known-systems-with-bad-secondary-system-names*
#:known-system-with-bad-secondary-system-names-p
#:sysdef-error-component #:check-component-input
#:explain))
#:explain
;; for extending the component types
#:compute-component-children
#:class-for-type))
(in-package :asdf/parse-defsystem)
;;; Pathname
......@@ -48,20 +51,33 @@
nil)))))
(when-upgrading (:version "3.3.4.17")
;; This turned into a generic function in 3.3.4.17
(fmakunbound 'class-for-type))
;;; Component class
(with-upgradability ()
;; What :file gets interpreted as, unless overridden by a :default-component-class
(defvar *default-component-class* 'cl-source-file)
(defun class-for-type (parent type)
(or (coerce-class type :package :asdf/interface :super 'component :error nil)
(and (eq type :file)
(coerce-class
(or (loop :for p = parent :then (component-parent p) :while p
:thereis (module-default-component-class p))
*default-component-class*)
:package :asdf/interface :super 'component :error nil))
(sysdef-error "don't recognize component type ~S" type))))
(defgeneric class-for-type (parent type-designator)
(:documentation
"Return a CLASS object to be used to instantiate components specified by TYPE-DESIGNATOR in the context of PARENT."))
(defmethod class-for-type ((parent null) type)
"If the PARENT is NIL, then TYPE must designate a subclass of SYSTEM."
(or (coerce-class type :package :asdf/interface :super 'system :error nil)
(sysdef-error "don't recognize component type ~S in the context of no parent" type)))
(defmethod class-for-type ((parent parent-component) type)
(or (coerce-class type :package :asdf/interface :super 'component :error nil)
(and (eq type :file)
(coerce-class
(or (loop :for p = parent :then (component-parent p) :while p
:thereis (module-default-component-class p))
*default-component-class*)
:package :asdf/interface :super 'component :error nil))
(sysdef-error "don't recognize component type ~S" type))))
;;; Check inputs
......@@ -268,37 +284,14 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~
system names contained using COERCE-NAME. Return the result."
(mapcar 'parse-dependency-def dd-list))
;;; Helper function for parse-component-form. Sets the CHILDREN slot of
;;; COMPONENT, using COMPONENTS list, and adds dependency links if
;;; the COMPONENT is a serial component. Should ONLY be called on a
;;; PARENT-COMPONENT.
;;; Returns the list of child components -- it's not entirely clear to me
;;; what is the set of possible values for elements of this list.
(declaim (ftype (function (parent-component list (or t nil)) t)
compute-component-children)
(ftype (function ((or parent-component null) list &key (:previous-serial-components list)))
parse-component-form))
(defun* compute-component-children (component components serial-p)
(prog1
(setf (component-children component)
(loop
:with previous-components = nil ; list of strings
:for c-form :in components
:for c = (parse-component-form component c-form
:previous-serial-components previous-components)
:for name :of-type string = (component-name c)
:collect c
:when serial-p
;; if this is an if-feature component, we need to make a serial link
;; from previous components to following components -- otherwise should
;; the IF-FEATURE component drop out, the chain of serial dependencies will be
;; broken.
:unless (component-if-feature c)
:do (setf previous-components nil)
:end
:and :do (push name previous-components)))
(compute-children-by-name component)))
(defgeneric compute-component-children (component components serial-p)
(:documentation
"Return a list of children for COMPONENT.
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))
(append s1
......@@ -356,7 +349,8 @@ system names contained using COERCE-NAME. Return the result."
;; A better fix is required.
(setf (slot-value component 'version) version)
(when (typep component 'parent-component)
(compute-component-children component components serial))
(setf (component-children component) (compute-component-children component components serial))
(compute-children-by-name component))
(when previous-serial-components
(setf depends-on (stable-union depends-on previous-serial-components :test #'equal)))
(when weakly-depends-on
......@@ -373,6 +367,26 @@ system names contained using COERCE-NAME. Return the result."
(coerce-name (component-system component))))
component)))
(defmethod compute-component-children ((component parent-component) components serial-p)
(loop
:with previous-components = nil ; list of strings
:for c-form :in components
:for c = (parse-component-form component c-form
:previous-serial-components previous-components)
:for name :of-type string = (component-name c)
:when serial-p
;; if this is an if-feature component, we need to make a serial link
;; from previous components to following components -- otherwise should
;; the IF-FEATURE component drop out, the chain of serial dependencies will be
;; broken.
:unless (component-if-feature c)
:do (setf previous-components nil)
:end
:and
:do (push name previous-components)
:end
:collect c))
;; the following are all systems that Stas Boukarev maintains and refuses to fix,
;; hoping instead to make my life miserable. Instead, I just make ASDF ignore them.
(defparameter* *known-systems-with-bad-secondary-system-names*
......@@ -436,7 +450,7 @@ system names contained using COERCE-NAME. Return the result."
(error 'non-system-system :name name :class-name (class-name class)))
(unless (eq (type-of system) class)
(reset-system-class system class)))
(parse-component-form nil (list* :module name :pathname directory component-options))))
(parse-component-form nil (list* :system name :pathname directory component-options))))
(defmacro defsystem (name &body options)
`(apply 'register-system-definition ',name ',options)))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment