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

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
......@@ -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:
......
......@@ -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.
......
......@@ -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))))
......@@ -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)
......
......@@ -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)
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