Commit e506e91a authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Move the inline-method support to parse-defsystem 

from backward-internals, where it doesn't belong (anymore),
since there is no longer any desire to deprecate the feature.
parent 15c022dc

Makefile

+1 −1
Changes for Makefile: 1 added line, 1 removed line.
Original line number Diff line number Diff line
@@ -69,7 +69,7 @@ XCL ?= xcl 


header_lisp := header.lisp

driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/run-program.lisp uiop/lisp-build.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp

defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp package-inferred-system.lisp interface.lisp user.lisp footer.lisp

defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp

all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)



# Making ASDF itself should be our first, default, target:

asdf.asd

+6 −6
Changes for asdf.asd: 6 added lines, 6 removed lines.
Original line number Diff line number Diff line
@@ -56,16 +56,16 @@ 
   (:file "operate" :depends-on ("plan"))

   (:file "output-translations" :depends-on ("operate"))

   (:file "source-registry" :depends-on ("find-system"))

   (:file "backward-internals" :depends-on ("lisp-action" "operate"))

   (:file "parse-defsystem" :depends-on ("backward-internals" "cache" "system"))

   (:file "parse-defsystem" :depends-on ("cache" "system" "lisp-action" "operate"))

   (:file "bundle" :depends-on ("lisp-action" "operate" "parse-defsystem"))

   (:file "concatenate-source" :depends-on ("plan" "parse-defsystem" "bundle"))

   (:file "backward-interface" :depends-on ("operate" "output-translations"))

   (:file "package-inferred-system" :depends-on ("system" "find-system" "parse-defsystem"))

   (:file "backward-internals" :depends-on ("find-system" "parse-defsystem"))

   (:file "backward-interface" :depends-on ("operate" "output-translations"))

   (:file "interface" :depends-on

          ("parse-defsystem" "concatenate-source"

           "backward-interface" "backward-internals"

           "output-translations" "source-registry" "package-inferred-system"))

           "output-translations" "source-registry" "package-inferred-system"

           "backward-interface" "backward-internals"))

   (:file "user" :depends-on ("interface"))

   (:file "footer" :depends-on ("user"))))
@@ -78,7 +78,7 @@ 
  :version "3.1.4.6" ;; to be automatically updated by make bump-version

  :depends-on ()

  #+asdf3 :encoding #+asdf3 :utf-8

  :class #.(if (find-class 'package-inferred-system nil) 'package-inferred-system 'system)

  :class #+asdf3.1 package-inferred-system #-asdf3.1 system

  ;; For most purposes, asdf itself specially counts as a builtin system.

  ;; If you want to link it or do something forbidden to builtin systems,

  ;; specify separate dependencies on uiop (aka asdf-driver) and asdf/defsystem.

backward-internals.lisp

+1 −42
Changes for backward-internals.lisp: 1 added line, 42 removed lines.
Original line number Diff line number Diff line
@@ -3,56 +3,16 @@ 


(uiop/package:define-package :asdf/backward-internals

  (:recycle :asdf/backward-internals :asdf)

  (:use :uiop/common-lisp :uiop :asdf/upgrade

   :asdf/system :asdf/component :asdf/operation

   :asdf/find-system :asdf/action :asdf/lisp-action)

  (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system)

  (:export ;; for internal use

   #:load-sysdef #:make-temporary-package

   #:%refresh-component-inline-methods

   #:make-sub-operation

   #:load-sysdef #:make-temporary-package))

(in-package :asdf/backward-internals)



;;;; Backward compatibility with "inline methods"

(with-upgradability ()

  (defparameter* +asdf-methods+

    '(perform-with-restarts perform explain output-files operation-done-p))



  (defun %remove-component-inline-methods (component)

    (dolist (name +asdf-methods+)

      (map ()

           ;; this is inefficient as most of the stored

           ;; methods will not be for this particular gf

           ;; But this is hardly performance-critical

           #'(lambda (m)

               (remove-method (symbol-function name) m))

           (component-inline-methods component)))

    (component-inline-methods component) nil)



  (defun %define-component-inline-methods (ret rest)

    (loop* :for (key value) :on rest :by #'cddr

           :for name = (and (keywordp key) (find key +asdf-methods+ :test 'string=))

           :when name :do

           (destructuring-bind (op &rest body) value

             (loop :for arg = (pop body)

                   :while (atom arg)

                   :collect arg :into qualifiers

                   :finally

                      (destructuring-bind (o c) arg

                        (pushnew

                         (eval `(defmethod ,name ,@qualifiers ((,o ,op) (,c (eql ,ret))) ,@body))

                         (component-inline-methods ret)))))))



  (defun %refresh-component-inline-methods (component rest)

    ;; clear methods, then add the new ones

    (%remove-component-inline-methods component)

    (%define-component-inline-methods component rest)))



(when-upgrading (:when (fboundp 'make-sub-operation))

  (defun make-sub-operation (c o dep-c dep-o)

    (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))





;;;; load-sysdef

(with-upgradability ()

  (defun load-sysdef (name pathname)
@@ -65,4 +25,3 @@ 
    ;; this would be a bad idea, so preserve the old behavior.

    (make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf))))

parse-defsystem.lisp

+37 −2
Changes for parse-defsystem.lisp: 37 added lines, 2 removed lines.
Original line number Diff line number Diff line
@@ -6,8 +6,7 @@ 
  (:nicknames :asdf/defsystem) ;; previous name, to be compatible with, in case anyone cares

  (:use :uiop/common-lisp :asdf/driver :asdf/upgrade

   :asdf/cache :asdf/component :asdf/system

   :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/operate

   :asdf/backward-internals)

   :asdf/find-system :asdf/find-component :asdf/action :asdf/lisp-action :asdf/operate)

  (:import-from :asdf/system #:depends-on #:weakly-depends-on)

  (:export

   #:defsystem #:register-system-definition
@@ -123,6 +122,42 @@ 
          (invalid))))))





;;; "inline methods"

(with-upgradability ()

  (defparameter* +asdf-methods+

    '(perform-with-restarts perform explain output-files operation-done-p))



  (defun %remove-component-inline-methods (component)

    (dolist (name +asdf-methods+)

      (map ()

           ;; this is inefficient as most of the stored

           ;; methods will not be for this particular gf

           ;; But this is hardly performance-critical

           #'(lambda (m)

               (remove-method (symbol-function name) m))

           (component-inline-methods component)))

    (component-inline-methods component) nil)



  (defun %define-component-inline-methods (ret rest)

    (loop* :for (key value) :on rest :by #'cddr

           :for name = (and (keywordp key) (find key +asdf-methods+ :test 'string=))

           :when name :do

           (destructuring-bind (op &rest body) value

             (loop :for arg = (pop body)

                   :while (atom arg)

                   :collect arg :into qualifiers

                   :finally

                      (destructuring-bind (o c) arg

                        (pushnew

                         (eval `(defmethod ,name ,@qualifiers ((,o ,op) (,c (eql ,ret))) ,@body))

                         (component-inline-methods ret)))))))



  (defun %refresh-component-inline-methods (component rest)

    ;; clear methods, then add the new ones

    (%remove-component-inline-methods component)

    (%define-component-inline-methods component rest)))





;;; Main parsing function

(with-upgradability ()

  (defun* parse-dependency-def (dd)

test/test-inline-methods.script

+3 −2
Changes for test/test-inline-methods.script: 3 added lines, 2 removed lines.
Original line number Diff line number Diff line
@@ -14,8 +14,9 @@ 
                      (format t "Method run for ~A - *a* = ~S~%" (action-description o c) *a*)

                      (call-next-method)))))



;;; Note: not calling load-system, because on ECL that would be a load-fasl-op,

;;; and at most the file load-op happen, whereas the second .o is linked and never loaded.

;;; Note: not calling load-system, because on ECL that could end up being a load-fasl-op,

;;; and at most the file1 load-op happen, whereas the file2 .o is linked and never loaded

;;; (the linked fasl, on the other hand, will be loaded, but won't trigger the inline method).

(operate 'load-op :foo)



(assert-equal *a* 2)