diff --git a/Makefile b/Makefile index 200aadfbf7d1f9ad4554502951fbfdb6c862e124..aa2d085f44619fe18e2e1a1f6a962d61b6403900 100644 --- a/Makefile +++ b/Makefile @@ -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: diff --git a/asdf.asd b/asdf.asd index 4867674bffab15dcbc085c0c4f2979423c6c4478..40276875101aa908d7344190187243bed84185a2 100644 --- a/asdf.asd +++ b/asdf.asd @@ -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. diff --git a/backward-internals.lisp b/backward-internals.lisp index b907b5492173d4b270f9d2adfc221cd997972389..03b332e96871f75294eee5bef6acd0d68f298b8c 100644 --- a/backward-internals.lisp +++ b/backward-internals.lisp @@ -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)))) - diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index c500f50976f1436801389c3b93be5b08cda134c6..e674e0caa8f8049407c67ac5198bc2dd72168729 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -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) diff --git a/test/test-inline-methods.script b/test/test-inline-methods.script index b1eaaabd318fcfd03f542642cc65c32eed903a10..77d4f47b1d85f08c66d3fe6bf2d1a7486545981c 100644 --- a/test/test-inline-methods.script +++ b/test/test-inline-methods.script @@ -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)