Commit 1fdb7b8d authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'cleanups' into 'master'

Cleanups

This branch contains a few cleanups as I proofread the entire code.

Those currently in the pipe regard asdf upgrade, since the first file in asdf is upgrade.lisp.

See merge request !23
parents b0eb3f7a c7d05a55
Loading
Loading
Loading
Loading
+1 −17
Original line number Diff line number Diff line
@@ -8,14 +8,13 @@
   :asdf/component :asdf/system #:asdf/cache :asdf/find-system :asdf/find-component :asdf/operation)
  (:export
   #:action #:define-convenience-action-methods
   #:explain #:action-description
   #:action-description
   #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation #:non-propagating-operation
   #:component-depends-on
   #:input-files #:output-files #:output-file #:operation-done-p
   #:action-status #:action-stamp #:action-done-p
   #:component-operation-time #:mark-operation-done #:compute-action-stamp
   #:perform #:perform-with-restarts #:retry #:accept
   #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan
   #:action-path #:find-action #:stamp #:done-p
   #:operation-definition-warning #:operation-definition-error ;; condition
   ))
@@ -34,13 +33,6 @@ and a class-name or class designates the canonical instance of the designated cl
    '(or operation null symbol class)))


;;; TODO: These should be moved to asdf/plan and be made simple defuns.
(with-upgradability ()
  (defgeneric traverse-actions (actions &key &allow-other-keys))
  (defgeneric traverse-sub-actions (operation component &key &allow-other-keys))
  (defgeneric required-components (component &key &allow-other-keys)))


;;;; Reified representation for storage or debugging. Note: it drops the operation-original-initargs
(with-upgradability ()
  (defun action-path (action)
@@ -115,14 +107,6 @@ You can put together sentences using this phrase."))
    (format nil (compatfmt "~@<~A on ~A~@:>")
            (type-of operation) component))

  ;; This is for compatibility with ASDF 1, and is deprecated.
  ;; TODO: move it to backward-interface
  (defgeneric* (explain) (operation component)
    (:documentation "Display a message describing an action"))
  (defmethod explain ((o operation) (c component))
    (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c)))
  (define-convenience-action-methods explain (operation component))

  (defun format-action (stream action &optional colon-p at-sign-p)
    "FORMAT helper to display an action's action-description.
Use it in FORMAT control strings as ~/asdf-action:format-action/"
+18 −5
Original line number Diff line number Diff line
@@ -16,7 +16,8 @@
   #:operation-on-failure #:operation-on-warnings #:on-failure #:on-warnings
   #:component-property
   #:run-shell-command
   #:system-definition-pathname))
   #:system-definition-pathname
   #:explain))
(in-package :asdf/backward-interface)

(with-upgradability ()
@@ -52,9 +53,7 @@
  ;; More generally, if you have to do something when the operation was forced,
  ;; you should also do it when not, and vice-versa, because it really shouldn't matter.
  ;; Thus, the backward-compatible thing to do is to always return T.
  ;;
  ;; TODO: change this function to a defun that always returns T.
  (defmethod operation-forced ((o operation)) (getf (operation-original-initargs o) :force))
  (defmethod operation-forced ((o operation)) t)


  ;; These old interfaces from ASDF1 have never been very meaningful
@@ -182,10 +181,12 @@ Please use UIOP:RUN-PROGRAM instead."
          ((integer 0 255) exit-code)
          (t 255))))))


(with-upgradability ()
  (defvar *asdf-verbose* nil)) ;; backward-compatibility with ASDF2 only. Unused.

;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED.

;;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED.
(with-upgradability ()
  (defgeneric component-property (component property))
  (defgeneric (setf component-property) (new-value component property))
@@ -200,3 +201,15 @@ Please use UIOP:RUN-PROGRAM instead."
          (setf (slot-value c 'properties)
                (acons property new-value (slot-value c 'properties)))))
    new-value))


;;; This method survives from ASDF 1, but really it is superseded by action-description.
(with-upgradability ()
  (defgeneric* (explain) (operation component)
    (:documentation "Display a message describing an action.
DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead."))
  (defmethod explain ((o operation) (c component))
    (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c)))
  (define-convenience-action-methods explain (operation component)))

+17 −16
Original line number Diff line number Diff line
@@ -71,9 +71,8 @@ itself."))
  (defclass link-op (bundle-op) ()
    (:documentation "Abstract operation for linking files together"))

  (defclass gather-op (bundle-op)
    ;; TODO: rename the slot and reader gather-op to gather-operation
    ((gather-op :initform nil :allocation :class :reader gather-op)
  (defclass gather-operation (bundle-op)
    ((gather-operation :initform nil :allocation :class :reader gather-operation)
     (gather-type :initform :no-output-file :allocation :class :reader gather-type))
    (:documentation "Abstract operation for gathering many input files from a system"))

@@ -86,7 +85,7 @@ itself."))
  ;; and all system-level dependencies as required components.
  ;; Non-monolithic operations typically use compile-op as the dependent operation,
  ;; and all transitive sub-components as required components (excluding other systems).
  (defmethod component-depends-on ((o gather-op) (s system))
  (defmethod component-depends-on ((o gather-operation) (s system))
    (let* ((mono (operation-monolithic-p o))
           (deps
             (required-components
@@ -95,7 +94,7 @@ itself."))
                :keep-operation 'compile-op)))
      ;; NB: the explicit make-operation on ECL and MKCL
      ;; ensures that we drop the original-initargs and its magic flags when recursing.
      `((,(make-operation (or (gather-op o) (if mono 'lib-op 'compile-op))) ,@deps)
      `((,(or (gather-operation o) (if mono 'lib-op 'compile-op)) ,@deps)
        ,@(call-next-method))))

  ;; Create a single fasl for the entire library
@@ -112,7 +111,7 @@ itself."))
      :allocation :class))
    (:documentation "Operation class for loading the bundles of a system's dependencies"))

  (defclass lib-op (link-op gather-op non-propagating-operation)
  (defclass lib-op (link-op gather-operation non-propagating-operation)
    ((gather-type :initform :object :allocation :class)
     (bundle-type :initform :lib :allocation :class))
    (:documentation "Compile the system and produce a linkable static library (.a/.lib)
@@ -125,7 +124,7 @@ themselves. In any case, this operation will produce what you need to further bu
a static runtime for your system, or a dynamic library to load in an existing runtime."))

  (defclass compile-bundle-op (basic-compile-bundle-op selfward-operation
                               #+(or clasp ecl mkcl) link-op #-(or clasp ecl) gather-op)
                               #+(or clasp ecl mkcl) link-op #-(or clasp ecl) gather-operation)
    ((selfward-operation :initform '(prepare-bundle-op #+(or clasp ecl) lib-op)
                         :allocation :class))
    (:documentation "This operator is an alternative to COMPILE-OP. Build a system
@@ -145,7 +144,7 @@ faster and more resource efficient."))
  ;; we'd have to have the monolithic-op not inherit from the main op,
  ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above.

  (defclass dll-op (link-op gather-op non-propagating-operation)
  (defclass dll-op (link-op gather-operation non-propagating-operation)
    ((gather-type :initform :object :allocation :class)
     (bundle-type :initform :dll :allocation :class))
    (:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)
@@ -170,10 +169,12 @@ for all the linkable object files associated with the system. Compare with LIB-O

  (defclass monolithic-compile-bundle-op
      (monolithic-bundle-op basic-compile-bundle-op
       #+(or clasp ecl mkcl) link-op gather-op non-propagating-operation)
    ((gather-op :initform #-(or clasp ecl mkcl) 'compile-bundle-op #+(or clasp ecl mkcl) 'lib-op
       #+(or clasp ecl mkcl) link-op gather-operation non-propagating-operation)
    ((gather-operation
      :initform #-(or clasp ecl mkcl) 'compile-bundle-op #+(or clasp ecl mkcl) 'lib-op
      :allocation :class)
     (gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :static-library
     (gather-type
      :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :static-library
      :allocation :class))
    (:documentation "Create a single fasl for the system and its dependencies."))

@@ -192,7 +193,7 @@ for all the linkable object files associated with the system or its dependencies
for all the linkable object files associated with the system or its dependencies. See LIB-OP"))

  (defclass image-op (monolithic-bundle-op selfward-operation
                      #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-op)
                      #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-operation)
    ((bundle-type :initform :image)
     #+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class)
     (selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class))
@@ -333,7 +334,7 @@ or of opaque libraries shipped along the source code."))
  (defun pathname-type-equal-function (type)
    #'(lambda (p) (equalp (pathname-type p) type)))

  (defmethod input-files ((o gather-op) (c system))
  (defmethod input-files ((o gather-operation) (c system))
    (unless (eq (bundle-type o) :no-output-file)
      (direct-dependency-files
       o c :key 'output-files
@@ -454,7 +455,7 @@ or of opaque libraries shipped along the source code."))
  (defmethod perform ((o dll-op) (c prebuilt-system))
    nil)

  (defmethod component-depends-on ((o gather-op) (c prebuilt-system))
  (defmethod component-depends-on ((o gather-operation) (c prebuilt-system))
    nil)

  (defmethod output-files ((o lib-op) (c prebuilt-system))
+2 −2
Original line number Diff line number Diff line
@@ -49,7 +49,7 @@
    (:documentation "Top-level system containing the COMPONENT"))
  (defgeneric component-pathname (component)
    (:documentation "Pathname of the COMPONENT if any, or NIL."))
  (defgeneric (component-relative-pathname) (component)
  (defgeneric* (component-relative-pathname) (component)
    ;; in ASDF4, rename that to component-specified-pathname ?
    (:documentation "Specified pathname of the COMPONENT,
intended to be merged with the pathname of that component's parent if any, using merged-pathnames*.
@@ -78,7 +78,7 @@ or NIL for top-level components (a.k.a. systems)"))

  ;; Deprecated: Backward compatible way of computing the FILE-TYPE of a component.
  ;; TODO: find users, have them stop using that, remove it for ASDF4.
  (defgeneric (source-file-type) (component system)
  (defgeneric* (source-file-type) (component system)
    (:documentation "DEPRECATED. Use the FILE-TYPE of a COMPONENT instead."))

  (define-condition system-definition-error (error) ()
+2 −2
Original line number Diff line number Diff line
@@ -6,7 +6,7 @@
  (:use :uiop/common-lisp :uiop :asdf/upgrade
   :asdf/component :asdf/operation
   :asdf/system :asdf/find-system
   :asdf/action :asdf/lisp-action :asdf/bundle)
   :asdf/action :asdf/lisp-action :asdf/plan :asdf/bundle)
  (:export
   #:concatenate-source-op
   #:load-concatenated-source-op
@@ -24,7 +24,7 @@
(with-upgradability ()
  ;; Base classes for both regular and monolithic concatenate-source operations
  (defclass basic-concatenate-source-op (bundle-op)
    ((bundle-type :initform "lisp")))
    ((bundle-type :initform "lisp" :allocation :class)))
  (defclass basic-load-concatenated-source-op (basic-load-op selfward-operation) ())
  (defclass basic-compile-concatenated-source-op (basic-compile-op selfward-operation) ())
  (defclass basic-load-compiled-concatenated-source-op (basic-load-op selfward-operation) ())
Loading